Sub test()
Dim c As Range
Dim lngZiel As Long
Dim strFirst As String
Dim strSuche As String
strSuche = "DeinSuchbegriff"
Application.ScreenUpdating = False
On Error GoTo Fehler
With Sheets("Tabelle1")
lngZiel = 20
Set c = Sheets("Suchblatt").Columns(5).Find(strSuche, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
strFirst = c.Address
Do
Sheets("Suchblatt").Rows(c.Row).Copy
.Cells(lngZiel, 1).PasteSpecial Paste:=xlValues
lngZiel = lngZiel + 1
Set c = Sheets("Suchblatt").Columns(5).FindNext(c)
Loop While Not c Is Nothing And c.Address <> strFirst
End If
End With
Application.CutCopyMode = False
Fehler:
Application.ScreenUpdating = True
End Sub