Sub FindenUndKopieren01()
Dim rng As Range
Dim loDeinWert As String
Dim sFirstadress As String
loDeinWert = "foci"
Set rng = Worksheets("Tabelle1").Range("A1:A189").find(loDeinWert)
If rng Is Nothing Then
MsgBox "Wort " & loDeinWert & " nicht gefunden!"
Else
sFirstadress = rng.Address
Do
rng.EntireRow.Copy
Worksheets("Tabelle2").Cells(Rows.Count, "A").End(xlUp) _
.Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Columns(1).EntireColumn.AutoFit
Set rng = Worksheets("Tabelle1").Range("A:B").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> sFirstadress
End If
End Sub