Private Sub Uebertragen()
Dim Zeile As Integer
Dim Zeile2 As Integer
Dim Spalte As Integer
Dim Blatt As String
Dim Blatt2 As String
Dim Name As Variant
Application.Calculation = xlManual
Application.ScreenUpdating = False
Blatt = ActiveSheet.Name
Spalte = InputBox("zu durchsuchende Spalte:", "Eingabe")
Name = InputBox("Kopieren von:", "Eingabe")
Blatt2 = InputBox("Kopieren nach:", "Eingabe")
Zeile2 = Sheets(Blatt2).Cells(Rows.Count, Spalte).End(xlUp).Row
For Zeile = 1 To Sheets(Blatt).Cells(Rows.Count, Spalte).End(xlUp).Row
If Sheets(Blatt).Cells(Zeile, Spalte).Value = Name Then
With Worksheets(Blatt)
.Range("A" & Zeile & ":IV" & Zeile).Copy Worksheets(Blatt2).Range("A" & Zeile2 & ":IV" & Zeile2)
End With
Zeile2 = Zeile2 + 1
End If
Next Zeile
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Dieser Code greift zwar nicht auf den Autofilter zurück, sollte aber trotzdem funktionieren. Bei der ersten Eingabe sagst du in welcher Spalte gesucht werden soll (zB. 2 für Spalte B), danach den Namen nach denen du "filtern" möchtest und zuletzt in welches Tabellenblatt kopiert werden soll (zB. Tabelle2)...