VBA: Wie Autofilter zu ignorieren, wenn Zelle Referenzwert leer ist

Question

Ich versuche zu filtern und zu extrahieren Daten aus Blatt "Daten" abhängig von mehreren Kriterien in einem separaten Blatt "Filter" eingegeben. Da jedoch einige der Kriterienfelder im Blatt "Filter" leer sind, sind die zurückgegebenen Daten leer. Gibt es eine Möglichkeit zu ignorieren, wenn eines der eingegebenen Kriterien leer ist und mit der Datenfilterung mit anderen Kriterien fortfahren und Daten zurückgeben? Im Folgenden ist der Code, den ich bisher geschrieben:

Sub CopyPastingFilteredData() 
Dim wb As Workbook 
Set wb = ActiveWorkbook 
If Sheets("Data").FilterMode Then 
Cells.AutoFilter 
End If 
'Filtering Data 
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=1, Criteria1:=Sheets("Filters").Range("C4").Text 
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=50, Criteria1:=Sheets("Filters").Range("C5") 
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=19, Criteria1:=Sheets("Filters").Range("C6") 
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=5, Criteria1:=Sheets("Filters").Range("C7") 
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=51, Criteria1:=Sheets("Filters").Range("C8") 
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=20, Criteria1:=Sheets("Filters").Range("C9") 
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=23, Criteria1:=Sheets("Filters").Range("C10") 
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=7, Criteria1:=Sheets("Filters").Range("C11") 
'Copying Data post filtering 
wb.Sheets("Data").Range("A3:BB20000").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy 

wb.Sheets("Extract").Select 
Cells(12, 1).PasteSpecial Paste:=xlPasteValues 


Set FilterRange = Nothing 
Application.ScreenUpdating = True 
Application.CutCopyMode = False 
Sheets("Data").Select 
Sheets("Data").Activate 
Cells.AutoFilter 
Sheets("Extract").Select 
Sheets("Extract").Activate 

End Sub 

Answer 1

Sie testen können, ob die Zelle die ersten Daten vor dem Filtern enthält. Ich habe Ihre Filtering Data Abschnitt weiter unten

Sub CopyPastingFilteredData() 
Dim wb As Workbook 
Dim shF As Worksheet 
Set wb = ActiveWorkbook 
Set shF = wb.Sheets("Filters") 
If Sheets("Data").FilterMode Then 
Cells.AutoFilter 
End If 
'Filtering Data 
With wb.Sheets("Data").Range("A2:BB20000") 
    If shF.Range("C4").Value <> "" Then .AutoFilter field:=1, Criteria1:=shF.Range("C4").Text 
    If shF.Range("C5").Value <> "" Then .AutoFilter field:=50, Criteria1:=shF.Range("C5") 
    If shF.Range("C6").Value <> "" Then .AutoFilter field:=19, Criteria1:=shF.Range("C6") 
    If shF.Range("C7").Value <> "" Then .AutoFilter field:=5, Criteria1:=shF.Range("C7") 
    If shF.Range("C8").Value <> "" Then .AutoFilter field:=51, Criteria1:=shF.Range("C8") 
    If shF.Range("C9").Value <> "" Then .AutoFilter field:=20, Criteria1:=shF.Range("C9") 
    If shF.Range("C10").Value <> "" Then .AutoFilter field:=23, Criteria1:=shF.Range("C10") 
    If shF.Range("C11").Value <> "" Then .AutoFilter field:=7, Criteria1:=shF.Range("C11") 
End With 
'Copying Data post filtering 
wb.Sheets("Data").Range("A3:BB20000").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy 

wb.Sheets("Extract").Select 
Cells(12, 1).PasteSpecial Paste:=xlPasteValues 


Set FilterRange = Nothing 
Application.ScreenUpdating = True 
Application.CutCopyMode = False 
Sheets("Data").Select 
Sheets("Data").Activate 
Cells.AutoFilter 
Sheets("Extract").Select 
Sheets("Extract").Activate 

End Sub