Kopieren von Zeilen zwischen zwei Datumsangaben

Private Sub nach_Datum_suchen() Dim lngZeile As Long, lngZiel As Long Dim varAntwort Dim datStart As Date, datEnde As Date varAntwort = InputBox("Bitte Anfangsdatum des Zeitraums eingeben:", "Startdatum") If varAntwort "" Then If IsDate(varAntwort) Then datStart = CDate(varAntwort) Else MsgBox "Eingegebenens Startdatum fehlerhaft!" Exit Sub End If Else MsgBox "Startdatum fehlt!" Exit Sub End If varAntwort = InputBox("Bitte Endedatum des Zeitraums eingeben:", "Endedatum") If varAntwort "" Then If IsDate(varAntwort) Then datEnde = CDate(varAntwort) Else MsgBox "Eingegebenens Endedatum fehlerhaft!" Exit Sub End If Else MsgBox "Endedatum fehlt!" Exit Sub End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
hier deine Datei mit neuem Code: https://www.herber.de/bbs/user/116630.xlsm
Hier nur Code:

Option Explicit
Private First_Match, Second_Match As Date
Public Sub ExecuteMatching()
Dim ArchivTable As Worksheet
Dim start_, end_ As Long
Dim lRow As Long
Dim rng As Range
'//Get Userinput
DefineMatches
'//If something went wrong, exit here
If IsNull(First_Match) Or IsNull(Second_Match) Then Exit Sub
'//Define Range we need it later!
Set ArchivTable = ThisWorkbook.Sheets("Archiv")
With ArchivTable
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(1, 1), .Cells(lRow, 1))
End With
'//Position of first Input
'//Position of second Input
start_ = MatchThis(First_Match, ArchivTable, rng)
end_ = MatchThis(Second_Match, ArchivTable, rng)
'//If the second input couldnt be found, then just copy nothing
'//if you want to copy everything to the end instead just do: If end_ = 0 Then end_ = lRow
If start_ = 0 Or end_ = 0 Then Exit Sub
'//Define new range with our start and end points
With ArchivTable
Set rng = .Range(.Cells(start_, 1), .Cells(end_, 4))
End With
'//Export this range to a other sheet
ExportToSheet "Auswahl", rng
MsgBox "Done!"
Set rng = Nothing
Set ArchivTable = Nothing
End Sub
'//Get User Input
Private Sub DefineMatches()
Dim datStart As Date, datEnde As Date
Dim varAntwort As Variant
varAntwort = InputBox("Bitte Anfangsdatum des Zeitraums eingeben:", "Startdatum")
If varAntwort  "" Then
If IsDate(varAntwort) Then
datStart = CDate(varAntwort)
First_Match = datStart
Else
MsgBox "Eingegebenens Startdatum fehlerhaft!"
Exit Sub
End If
Else
MsgBox "Startdatum fehlt!"
Exit Sub
End If
varAntwort = InputBox("Bitte Endedatum des Zeitraums eingeben:", "Endedatum")
If varAntwort  "" Then
If IsDate(varAntwort) Then
datEnde = CDate(varAntwort)
Second_Match = datEnde
Else
MsgBox "Eingegebenens Endedatum fehlerhaft!"
Exit Sub
End If
Else
MsgBox "Endedatum fehlt!"
Exit Sub
End If
End Sub
'//Find the Match
'//We convert the Date to a Long, because Match wont work with normal date objects
Private Function MatchThis(ByVal Match_ As Variant, ws As Worksheet, rng As Range)
With ws
With Application
If Not VBA.IsError(.Match(CLng(Match_), rng, 0)) Then
MatchThis = .Match(CLng(Match_), rng, 0)
End If
End With
End With
End Function
'//Export the created Range to the given sheet
Private Sub ExportToSheet(ByVal SheetName As String, ByVal Range_ As Range)
Dim worksheet_ As Worksheet
Dim lRow As Long
Set worksheet_ = ThisWorkbook.Sheets(SheetName)
With worksheet_
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & lRow).Resize(Range_.Rows.Count, Range_.Columns.Count) = Range_.Value
End With
End Sub

Hallo Peter,
nicht übel, dein Code. Die Krux ist nur, dass bei Datumseingaben, die nicht exakt den Daten im Blatt "Archiv" entsprechen, weder ein Resultat erzeugt wird, noch eine Meldung erfolgt.
Beispiel: 01.01.2017 bis 19.05.2017 oder 16.01.2017 bis 31.08.2017.
Ich hatte mich auch schon mit Oliver's Frage beschäftigt, bin aber schließlich zu dem Schluss gekommen, dass es vermutlich sinnvoller ist, die Datumseingaben (von/bis) per MouseClick über eine Listbox abzufragen.
Und noch zwei Anmerkung nebenbei:
Vor dem Kopieren der Daten in Tabelle "Auswahl" müssen natürlich die Zeilen mit "alten" Daten unterhalb der Überschrift gelöscht werden!
Als NICE-TO-HAVE wäre es schön, wenn nach Bestätigung von "Done" das Blatt
"Auswahl" angezeigt würde.
Ich hoffe, du fasst meine Anmerkungen nicht als Negativ-Kritik auf!
Gruß, Rolf

Beliebteste Forumthreads (12 Monate)

Kopieren von Zeilen zwischen zwei Datumsangaben

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopieren von Zeilen zwischen zwei Datumsangaben

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread