Daten in letzten 4 Monaten filtern auch bei Jahreswechseln
07.01.2020 09:22:24
RO
ich habe diese Makro und funktioniert sehr gut. Problem ist Jahreswechsel. Wenn ich z.B die Daten von letzten 4 Monaten ( Jan 2020, Dez 2019, Nov 2019 und Okt 2019) filtern und kopieren möchte, kopiert die Makro nur die daten von Jan 2020, also vom aktuellen Jahr. Ich sehe in Makro, dass diese Makro so geschrieben ist, dass er nur die Daten von letzten 4 Monaten des aktuellen Jahres filtert und kopiert.
Ich hab keine Ahnung wie man es ändern kann, damit die Makro immer die daten von letzten 4 Monaten unäbhänging von dem Jahr, filtert und kopiert.
Könnte jemand mir helfen?
Hier z.B die Code:
Sub Kopieren()
' Nachricht Makrostart
If MsgBox("Ist der aktuelleste Datenbank-Export in dieser Datei hinterlegt", vbYesNo) = vbNo _
Then
MsgBox "Bitte erst den Datenbank-Export ?ber den DB_Overview laden, ?ffnen & via Button - _
Abfrage importieren- einf?gen! Achtung Text in Spalten im Abfrage nicht vergessen!"
Exit Sub
Else
' Bildschirmaktivit?t aus
Application.ScreenUpdating = False
'---------------------Vorbereitung---------------------------------------
' Variable definieren
Dim dDate, dTime As Date
Dim AnzahlL As Integer
'Dim Filtermonate As Variant
'Dim Filtermonat1, Filtermonat2, Filtermonat3, Filtermonat4 As Variant
' Abfrage zum Datenstand
Sheets("Makros").Select
dDate = Cells(11, 16)
dTime = Cells(12, 16)
' Variablebelegung f?r Jahresvorgabe siehe Tabellenblatt Makros Zelle F9
Sheets("Makros").Select
ActiveSheet.Calculate
Jahresvorgabe = Cells(12, 6)
Monatsvorgabe = Cells(13, 6)
' Variablebelegung f?r auszuwertende Monate Tabellenblatt Makros Zelle F13
'Filtermonate = Array(Worksheets("Makros").Range("H10:H13").Value)
Filtermonat4 = Cells(10, 8)
Filtermonat3 = Cells(11, 8)
Filtermonat2 = Cells(12, 8)
Filtermonat1 = Cells(13, 8)
'Filtermonate = Array(Filtermonat1, Filtermonat2, Filtermonat3, Filtermonat4)
' Blatt Chrosscheck Datenbereinigung -------(letzte Beschriebene Spalte auslesen)
Sheets("CS_Masterliste").Select
Columns("A:AG").EntireColumn.Hidden = False
With Sheets("CS_Masterliste")
If .FilterMode Then
.ShowAllData
End If
End With
Range("A10:AG60000").Select
Selection.ClearContents
' Tabelle Abfrage alle Daten anzeigen
Sheets("Abfrage").Select
Columns("A:CF").EntireColumn.Hidden = False
With Sheets("Abfrage")
If .FilterMode Then
.ShowAllData
End If
End With
'---------------------Filtern---------------------------------------
' Tabelle Abfrage_Export nach Team bewertete Reporte Filtern
ActiveSheet.Range("$A$4:$A$6000").AutoFilter Field:=1, Criteria1:="=TE", _
Operator:=xlOr
' Tabelle Abfrage_Export f?r Masterliste Filtern (alle Werke)
ActiveSheet.Range("$A$4:$BA$6000").AutoFilter Field:=53, Criteria1:=Array( _
"MZW", "MZX", "MZR", "MZD", "MZS", "MZA"), Operator:=xlFilterValues
' Tabelle Abfrage_Export nach Auswertemonaten filtern
If Monatsvorgabe = "Januar" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"1", "12", "11", "10"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Februar" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"2", "1", "12", "11"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "M?rz" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"3", "2", "1", "12"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "April" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"4", "3", "2", "1"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Mai" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"5", "4", "3", "2"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Juni" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"6", "5", "4", "3"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Juli" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"7", "6", "5", "4"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "August" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"8", "7", "6", "5"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "September" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"9", "8", "7", "6"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Oktober" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"10", "9", "8", "7"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "November" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"11", "10", "9", "8"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Dezember" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"12", "11", "10", "9"), Operator:=xlFilterValues
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
'ActiveSheet.Range("$A$4:$BO$60000").AutoFilter Field:=67, Criteria1:= _
Filtermonat1, Criteria2:=Filtermonat2, Criteria3:=Filtermonat3, Criteria4:=Filtermonat4, Operatort:=x10r
' Tabelle Abfrage nach Jahr filtern
If Jahresvorgabe = "2017" Then
ActiveSheet.Range("$A$4:$CD$6000").AutoFilter Field:=82, Criteria1:="=2017", _
Operator:=xlOr
Else
If Jahresvorgabe = "2018" Then
ActiveSheet.Range("$A$1:$CD$6000").AutoFilter Field:=82, Criteria1:="=2018", _
Operator:=xlOr
Else
If Jahresvorgabe = "2019" Then
ActiveSheet.Range("$A$1:$CD$6000").AutoFilter Field:=82, Criteria1:="=2019", _
Operator:=xlOr
Else
If Jahresvorgabe = "2020" Then
ActiveSheet.Range("$A$1:$CD$6000").AutoFilter Field:=82, Criteria1:="=2020", _
Operator:=xlOr
End If
End If
End If
End If
'ActiveSheet.Range("$A$4:$CD$6000").AutoFilter Field:=17, Criteria1:=Jahresvorgabe, _
Operator:=xlFilterValues
' LNR
Sheets("Abfrage").Select
Range("G5:G60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("N10").Select
ActiveSheet.Paste
' Gruppe = Gruppe
Sheets("Abfrage").Select
Range("AZ5:AZ60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("R10").Select
ActiveSheet.Paste
' Verteildatum, Eingangsdatum, Solltdatum
Sheets("Abfrage").Select
Range("K5:M60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("S10").Select
ActiveSheet.Paste
' Bewertung abgegeben
Sheets("Abfrage_Export_DE").Select
Range("N5:N60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("V10").Select
ActiveSheet.Paste
' Status
Sheets("Abfrage").Select
Range("P5:P60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("W10").Select
ActiveSheet.Paste
' Datum
Sheets("Abfrage").Select
Range("Q5:Q60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("X10").Select
ActiveSheet.Paste
' letzte beschrieben Zeile ermitteln
letztezeile1 = ActiveSheet.Cells(60000, 10).End(xlUp).Row
End Sub