VBA Erweiterter Filter Ausgabe anpassen
21.01.2021 16:47:47
Thomas
ich habe folgendes Problem. Ich habe ein Workbook mit mehreren Sheets, welche im Aufbau nahezu identisch sind.
Sie beinhalten jeweils eine Tabelle mit gleichen Angaben außer in einer Spalte.
Nun möchte ich diese Sheets mit dem Advanced Filter durchsuchen und das Ergebnis auf einem separaten Sheet listen lassen.
Dies klappt mit meinem bisherigen Script auch einwandfrei.
Was ich jedoch jetzt noch haben möchte und wo ich nicht weiterkomme ist, daß das Makro mir alle Suchergebnisse unter den Headern wieder in eine Tabelle wandelt.
Ich habe die Suchausgabe von Sheet3 im Beispiel File mal in solch eine manuell geändert wie ich sie möchte für alle 3.
Das bisherige Script sieht so aus und funktioniert auch bis zum Punkt der Wandlung in eine Tabelle.
Vielleicht hat ja jemand eine Idee.
-----------------
Sub Macro1()
' Macro1 Macro
Dim lngLastRow As Long
Dim lngLastRowSC As Long
lngLastRow = Sheets("Ziel").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowSC = Sheets("Such").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Ziel").Select
Sheets("Ziel").Range("A1:E" & lngLastRow).Clear
Sheets("Sheet3").Range("Table1[#All]").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Such").Range("A1:C2"), CopyToRange:=Range("A1"), _
Unique:=False
lngLastRow = Sheets("Ziel").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet4").Range("Table2[#All]").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Such").Range("A1:C2"), CopyToRange:=Range("A" & lngLastRow + 1), _
_
_
Unique:=False
lngLastRow = Sheets("Ziel").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet5").Range("Table3[#All]").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Such").Range("A1:C2"), CopyToRange:=Range("A" & lngLastRow + 1), _
_
_
Unique:=False
End Sub
https://www.herber.de/bbs/user/143202.zip