AW: Daten nach für eine bestimmte Zeitraum filtern
08.01.2020 16:53:03
RO
Hier ist das Makro... Er filtert nur die Werte von aktuellen Jahr. Ich möchte dass er auch die Werte von letztes Jahr übernimmt. Z.b Oktober 2019-Jan 2020, weil diese sind die letzten 4 Monaten.
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