gesuchte Zeilen in anderes Blatt kopieren

Sub MehrfSucheKopieren()
Dim rngFind As Range
Dim rngRows As Range
Dim lngRow As Long
Dim strFind As String
Dim strSearch As String
Sheets(1).Activate
strSearch = Left("Testwort", 4)
Set rngFind = Columns(4).Find(strSearch)
If rngRows Is Nothing Then
Set rngRows = rngFind
End If
If Not rngFind Is Nothing Then
strFind = rngFind.Address
Do
Set rngRows = Application.Union(rngRows, rngFind.EntireRow)
Set rngFind = Columns(4).FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
rngRows.Select
Selection.Copy
Sheets(2).Activate
Cells(2, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub