Vergangene Daten rausfiltern
19.10.2020 12:59:09
Elysa
Ich habe einen Code, der nach Monaten filtert. Auf einer Übersichtsseite erscheinen alle Zeilen, die ein Datum enthalten, welches in diesem oder in den nächsten zwei Monaten ist. Ursprünglich wurde kein Tag angegeben, deshalb enthält der Code keine Angabe des heutigen Tages, sondern nur "01."
Jedoch würde ich gern, dass auch jeweils der heutige Tag berücksichtigt wird, sodass alles, was bereits in der Vergangenheit ist, NICHT erscheint, auch wenn es im aktuellen Monat ist. Ich habe mehrere Sachen probiert, jedoch schaffe ich es nicht. Ich weiss, ich müsste noch den Tag als integer (z.B. k = Format(Date, "dd")) hinzufügen, jedoch weiss ich nicht, was ich mit dem machen soll.
Hier mein Code:
Public Sub CopyRows()
Dim ws As Worksheet
Dim s_Main As String
Dim nRow As Long
Dim Last_row As Long
Dim i As Long
Dim Table As Variant
Dim x as integer
Dim y as integer
Dim Date1 as string
Dim Date2 as string
Dim Date3 as string
s_Main = "Overview"
Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(s_Main).Range("A2:P" & Last_row).ClearContents
x = Format(Date, "mm")
y = Format(Date, "yyyy")
Date1 = "01." & x & "." & y
If x = 12 Then
x = 1
y = y + 1
Else
x = x + 1
End If
Date2 = "01." & x & "." & y
If x = 12 Then
x = 1
y = y + 1
Else
x = x + 1
End If
Date3 = "01." & x & "." & y
For Each ws In Worksheets
If ws.Name = s_Main Then
GoTo Change_ws
Else
nRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
ReDim Table(nRows, 16)
Table = ws.Range("A1:P" & nRows)
For i = 1 To nRows
If Table(i, 2) = Date1 Or Table(i, 2) = Date2 Or Table(i, 2) = Date3 Then
Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("A" & i & ":P" & i).Copy Worksheets(s_Main).Range("A" & Last_row)(2)
End If
Next i
End If
Change_ws:
Next ws
End Sub
Bin echt dankbar um jeden Hinweis! Vielen Dank!