Zeilen mit Datumsbereich kopieren
10.06.2021 18:43:36
aculix
ich lese schon länger mit und konnte viele Probleme bisher mit den Beiträgen hier lösen.
Nun habe ich allerdings ein Problem für das ich keine funktionierende Lösung finde.
Problemstellung:
Vergleich von zwei Datumseinträgen: Spalte C (Startdatum) Spalte D ( Enddatum)
Sofern das Datum von heute zwischen C&D liegt sollen alle Zeilen, auf welche es zutrifft in eine andere Tabelle kopiert werden; Spalten A - M
Das funktioniert gelegentlich, wobei er nicht alle Zellhinhalte mit kopiert, sondern hin und wieder ab E nix überträgt oder nur vereinzelt.
Die Quelldaten in der Tabelle L23 sind nicht nach Datum sortiert, da sich um eine Tabelle zur Dateneditierung/Sammlung handelt.
Im zweiten Zug soll er weiterhin prüfen ob das Datum von C in der Zukunft liegt und diese Zeilen in ein weiteres Tabellenblatt kopieren. Da wird maximal C&D und irgendein Müll kopiert.
Die erste Zeile soll nicht kopiert werden.
Vielen Dank im Voraus.
Den folgenden Code habe ich mir halb lauffähig gebastelt:
Dim i As Integer
Dim ls As Integer
Dim ly As Integer
'Sheets("asd").Unprotect
Sheets("asd").Range("A1:N1337").ClearContents
Sheets("dsa").Range("A1:N1337").ClearContents
For i = 1 To Sheets("L23").Cells(Rows.Count, 1).End(xlUp).Row
If Sheets("L23").Cells(i, 3) Date + 1 Then
ls = Sheets("L23").Cells(i, 15).End(xlToLeft).Column
lz = Sheets("asd").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("L23").Range(Cells(i, 1), Sheets("L23").Cells(i, ls)).Copy Sheets("asd").Cells(lz, 1)
ElseIf Sheets("L23").Cells(i, 3) > Date - 1 Then
ls = Sheets("L23").Cells(i, 15).End(xlToLeft).Column
ly = Sheets("asd").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("L23").Range(Cells(i, 1), Sheets("L23").Cells(i, ly)).Copy Sheets("asd").Cells(ly, 1)
End If
Next i
'Sheets("asd").Protect
End Sub