Option Explicit
Sub AutofilterErgebnisKopieren()
Dim letzteZ As Long
Dim WksQ As Worksheet
Dim WksZ As Worksheet
Set WksQ = Worksheets("Quelle")
Set WksZ = Worksheets("Gefiltert")
'Bereich beginnt unterhalb der Filterzeile OffSet(1)
WksQ.AutoFilter.Range.Offset(1).Resize(WksQ.AutoFilter.Range.Rows.Count - 1).SpecialCells( _
xlCellTypeVisible).copy
With WksZ
.Rows("11:3000").Delete 'gefilterte Zeilen anpassen Maxwert
.Cells(11, 2).PasteSpecial Paste:=xlFormulas 'einfügen ab Zeile 11,Spalte2 (B11)
End With
Application.CutCopyMode = False 'Copymodus beenden
WksQ.Activate
End Sub
Option Explicit
Sub AutofilterErgebnisKopieren() 'MUSS vom QUELLBLATT ausgeführt werden!!!!!!
ActiveSheet.AutoFilter.Range.Offset(1). _
Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).copy
With Worksheets("Gefiltert")
.Rows("11:3000").Delete
.Cells(11, 2).PasteSpecial Paste:=xlFormulas
End With
Application.CutCopyMode = False
Sheets("Quelle").Activate
End Sub
Die Datei https://www.herber.de/bbs/user/89252.xlsm wurde aus Datenschutzgründen gelöscht