VBA - Datumsbereich markieren und in anderes Blatt kopieren

[HannesBo]

Hallo,

ich bin am verzweifeln.
Suche seid einigen Stunden eine Lösung für folgendes Problem:
Ich habe eine Mappe mit einem Tabellenblatt.
Die Anordnung sieht wie folgt aus:
Spalte D = Datum
Spalte E = Belegnummer
Spalte F = Verwendungszweck
usw.

Diese Tabelle fülle ich nun mit ca. 2000 Daten, sprich Belegen.

Später möchte ich dann einen Datumsbereich per VBA Userform auswählen können z.B. 01.03.2014 bis 16.05.2014

Danach soll der gesamte Bereich, sprich Zeile x bis Zeile y kopiert werden.
Danach werden die Zeilen in ein anderes Tabellenblatt kopiert und ausgedruckt.

Kann mir da vielleicht jemand helfen???

Ich bin für jede Hilfe dankbar!!!

Den Code hier habe ich mal versucht, scheinbar addiert er allerdings stets die Tage dazu...
Zum Verständnis:
Textbox1 = 1.12
Textbox2 = 15.12

Bereich, der markiert und kopiert wird = 1.12 bis 16.12

Anderes Beispiel:
Textbox1 = 5.12
Textbox2 = 15.12

Bereich, der markiert und kopiert wird = 5.12 bis 20.12

Woran könnte es liegen? Ich nin am überlegen, komme aber einfach nicht drauf!

Wie würde denn der Code aussehen, wenn ich z.B. die beiden Textboxen austausche?
Sprich, dass die beiden Werte "von" und "bis" in Zellen geschrieben werden.
A1=5.5.2014
A2=7.7.2014

Code:

Private Sub CommandButton1_Click()
Dim rngLast As Range
Dim rngFirst As Range
With Worksheets("Auswertung-Eingabe")
  Set rngLast = .Range("D:D").Find(what:=CDate(TextBox2), after:=.Range("D1"), Lookat:=xlPart, searchdirection:=xlPrevious)
  If Not rngLast Is Nothing Then
   Set rngFirst = .Range("D:D").Find(what:=CDate(TextBox1), after:=rngLast, Lookat:=xlPart, searchdirection:=xlNext)
     If Not rngFirst Is Nothing Then
      .Range(rngFirst, rngLast).Resize(rngLast.Row, 3).Copy Worksheets("Tabelle2").Range("A1")
     End If
  End If
End With
End Sub

Jemand ne Idee???

[Steffl]

Hallo,

ersetze folgende Codezeile

Code:

.Range(rngFirst, rngLast).Resize(rngLast.Row, 3).Copy Worksheets("Tabelle2").Range("A1")

durch diese (ungetestet)

Code:

.Cells(rngFirst.Row, 4).Resize(rngLast.Row - rngFirst.Row + 1, 3).Copy Worksheets("Tabelle2").Range("A1")

[Max]

Hi,

ich glaube zwar, dass es mehrere Baustellen sind aber probier mal Folgendes:

Set rngLast = .Range("D:D").Find(what:=Cdbl(CDate(TextBox2)), after:=.Range("D1"), Lookat:=xlPart, searchdirection:=xlPrevious)

Erfahrungsgemäß sind Suchen nach Datenbereichen immer etwas komplexer.
Um zu testen ob überhaupt ein Datum gefunden wird, hier ein alternatives Makro, dass ein Datum in Spalte "D" finden sollte.

Code:

Sub DatumFinden()
    Dim strDate As String
    Dim zelle As Range

    strDate = InputBox("Geben Sie ein Datum ein:  (TT/MM/JJJJ)")

    If strDate = "" Then Exit Sub
    Set zelle = Worksheets("Auswertung-Eingabe").Columns("D").Find(CDate(strDate), LookIn:=xlValues, lookat:=xlWhole)

    If zelle Is Nothing Then
        MsgBox "Datum nicht gefunden!"
    Else
        MsgBox "Datum ist in Zelle " & zelle.Address
    End If
    
End Sub

"Meine Daten" in Spalte "D" sehen so aus:

Arbeitsblatt mit dem Namen 'Auswertung-Eingabe'
	A	B	C	D
1				01.05.2014
2				02.05.2014
3				03.05.2014
4				04.05.2014
5				05.05.2014
6				06.05.2014
7				07.05.2014

Zelle	Format	Wert
D1	TT.MM.JJJJ	01.05.2014
D2	TT.MM.JJJJ	02.05.2014
D3	TT.MM.JJJJ	03.05.2014
D4	TT.MM.JJJJ	04.05.2014
D5	TT.MM.JJJJ	05.05.2014
D6	TT.MM.JJJJ	06.05.2014
D7	TT.MM.JJJJ	07.05.2014

Gruß
Max

[HannesBo]

Hallo Steffl,
Bestens...Funktioniert 1a...vielen vielen Dank!!!!

Hallo Max,
auch Dir sag ich danke für die Hilfe!!!

[HannesBo]

Hallo...sorry...
habe den Code wie folgt geändert, jedoch passiert nichts wenn das Datum, welches ich in der Textbox2 eingebe, nicht in der Tabelle aufgeführt ist?
Also kann ich nur Daten auswählen, welche auch in der Tabelle enthalten sind.
Da ich aber nicht für jeden Tag eine Buchung habe, funktioniert es nun doch nicht so wie Steffl es vorgeschlagen hat.

Gehts denn irgendwie anders???

[code]
Private Sub CommandButton1_Click()
Dim rngLast As Range
Dim rngFirst As Range
With Worksheets("Auswertung-Eingabe")
Set rngLast = .Range("D:D").Find(what:=CDate(TextBox2), after:=.Range("D1"), Lookat:=xlPart, searchdirection:=xlPrevious)
If Not rngLast Is Nothing Then
Set rngFirst = .Range("D:D").Find(what:=CDate(TextBox1), after:=rngLast, Lookat:=xlPart, searchdirection:=xlNext)
If Not rngFirst Is Nothing Then
.Cells(rngFirst.Row, 4).Resize(rngLast.Row - rngFirst.Row + 1, 3).Copy Worksheets("Tabelle2").Range("A1")
End If
End If
End With
End Sub

[Max]

Du könntest über den Autofilter arbeiten. Wenn Du ohnenhin mit einer UF arbeiten willst,
dann z.B. so:

Code:

Worksheets("Auswertung-Eingabe").Range("A1").AutoFilter field:=4, Criteria1:=">=" & _
        CDbl(UserForm1.TextBox1.Value), Operator:=xlAnd, Criteria2:="<=" & CDbl(UserForm1.TextBox2.Value)

Im Anschluß kannst Du abfragen, welche Zeilen sichtbar sind, eben die Deines gewählten Zeitraums, und dann
die sichtbaren Zeilen bzw. den benötigten sichtbaren Bereich kopieren.

Gruß
Max

[HannesBo]

Ich habe mal einen Auszug der Datei hinzugefügt...zu Testzwecken.
Wäre super, wenn mir da jemand weiterhelfen kann.

[HannesBo]

Hi Max,

ich weiss, es ist etwas spät, aber wärest Du so nett und würdest meine Mappe etwas umbauen .
Mit Autofilter habe ich noch nicht gearbeitet.

[atilla]

Hallo,

das ist eine typische Aufgabe für den Spezialfilter, wobei eine Pivottabelle auch zum gleichen Ziel führen würde.

Unten eine Beispielmappe mit Spezialfilter.


  Datumssuche.xlsm (Größe: 22,53 KB / Downloads: 19)

[Max]

Hi,

ich bin dran.
Hast Du die Spalten "A:C" gelöscht, oder sind diese auch in Deiner kompletten Version leer?

Gruß
Max