Autofilter
22.02.2021 14:04:54
Sarah
Ich habe hier ein Makro geschrieben.
Wenn ich jetzt das Makro ausführe mit einer Pfad von einem Ordner in dem mehrere Dateien drin sind, läuft es ohne Fehler durch bis es auf eine Datei stoßt die nur mit 15 Zeilen befüllt ist.
Dann gibt es einen Fehler beim Autofilter aus.
Wenn ich die 15 Zeilen in der Datei kopiere und 30 Zeilen drauß mache gibt mir das Makro keinen Fehler mehr bei der Datei aus.
Wo ist der Fehler im Makro, dass der Autofilter keine Dateien bearbeiten kann die weniger als eine bestimmte Anzahl von Zeilen haben?
"
Public Sub Ordner()
'Laufzeitoptimierung durch Unterdrückung von PopUps
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim strFile As String
Dim strPath As String
Dim strExt As String
Dim QWB As Workbook
Dim ZWB As Workbook
Set ZWB = ThisWorkbook
'löschen des Inhaltes
ZWB.Worksheets("GasPool").Select
ZWB.Worksheets("GasPool").Range(Cells(2, 1), Cells(Range("G2").End(xlDown).Row, 7)). _
ClearContents
strPath = Ordner.PFAD & "\"
strExt = "*.xlsx"
If strPath = "" Then Exit Sub
strFile = Dir$(strPath & strExt)
Do Until strFile = vbNullString
Workbooks.Open Filename:=(strPath & strFile), Local:=True
Set QWB = Workbooks(strFile)
'----------------------------------------------------------------------------------------------- _
'Makro Copy/Paste
With QWB.Worksheets
Selection.AutoFilter
ActiveSheet.Range("A:AM").AutoFilter Field:=6, Criteria1:= _
"=Abrechnung", Operator:=xlOr, Criteria2:="=" _
'Filtert nach "Abrechnung" und " "
Range(Cells(2, 3), Cells(Range("C2").End(xlDown).Row, 3)).Copy _
'Spalte A
ZWB.Worksheets("GasPool").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial _
xlPasteValues
Range(Cells(2, 4), Cells(Range("D2").End(xlDown).Row, 4)).Copy _
'Spalte B
ZWB.Worksheets("GasPool").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial _
xlPasteValues
Range(Cells(2, 2), Cells(Range("B2").End(xlDown).Row, 2)).Copy _
'Spalte C
ZWB.Worksheets("GasPool").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial _
xlPasteValues
Range(Cells(2, 5), Cells(Range("E2").End(xlDown).Row, 5)).Copy _
'Spalte D
ZWB.Worksheets("GasPool").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).PasteSpecial _
xlPasteValues
Range(Cells(2, 7), Cells(Range("G2").End(xlDown).Row, 7)).Copy _
'Spalte F
ZWB.Worksheets("GasPool").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial _
xlPasteValues
Range(Cells(2, 8), Cells(Range("H2").End(xlDown).Row, 8)).Copy _
'Spalte G
ZWB.Worksheets("GasPool").Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial _
xlPasteValues
Application.CutCopyMode = False
End With
QWB.Close SaveChanges:=False
strFile = Dir$ ' nächste Datei
Loop
Set OWB = Nothing
'Aus RLMMT wird "RLMMT_ABR"
ZWB.Worksheets("GasPool").Cells.Replace What:="RLMMT", Replacement:="RLMMT_ABR", LookAt:=xlPart, _
_
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Laufzeitoptimierung
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Danke für eure hilfe :)