Hallo Zusammen
Was mache ich falsch in meinem Code? Möchte ein Filterergebnis kopieren und in neue Tabelle einfügen. Filter generell funktioniert, jedoch kopiert es mir alle Daten und nicht das Filterergebnis. Komm nicht drauf was ich falsch geschrieben habe.
Liebe Gruess
Richi
<pre>Sub Tabelle_Filtern_kopieren()
Dim lZQ, lZZ, lZDyn, lSQ, lSZ As Long
Dim wb As Workbook
Dim wsQ As Worksheet
Dim wsZ As Worksheet
Set wb = ThisWorkbook
Set wsQ = wb.Worksheets("Auftragssteuerung")
Set wsZ = wb.Worksheets("46110 Spengler")
lZQ = wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row
lZZ = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row
lSQ = wsQ.Cells(4, wsQ.Columns.Count).End(xlToLeft).Column
lSZ = wsZ.Cells(1, wsZ.Columns.Count).End(xlToLeft).Column
wsZ.Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
wsQ.Select
wsQ.ListObjects("Tabelle2").Range.AutoFilter Field:=43, Criteria1:= _
"46110"
wsQ.ListObjects("Tabelle2").Range.AutoFilter Field:=3, Criteria1:= _
"<>PP**", Operator:=xlAnd, Criteria2:="<>PS**"
wsQ.Select
lZDyn = Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(1, 1), Cells(lZDyn, lSQ)).Select 'Selektieren des zu kopierenden Ranges
Selection.Copy
wsZ.Select
Cells(1, 1).Select 'Kopierter Range einfügen ab Zelle Daten & Formate
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
wsZ.Paste
wsZ.Cells(1, 1).Value = "Produktionssteuerung aktive Aufträge 46110 Spengler"
Range("A5").Select
wsQ.Select
Range("Tabelle2[#Headers]").Select
Selection.AutoFilter
Selection.AutoFilter
Range("Tabelle2[[#Headers],[Vrg]]").Select
Range("A5").Select
End Sub</pre>