Makro - suchen, kopieren, Inhalte einfügen

Sub Bundesländer()
'Bremen
Dim rng As Range, rngSource As Range, rngStart As Range
Dim varInput As Variant
Dim iRow As Integer
Set rng = ActiveSheet.Columns("D:D").Find("wd--hb")
If rng Is Nothing Then
Beep
MsgBox "Suchbegriff nicht gefunden!"
Exit Sub
End If
Set rngStart = rng
Set rngSource = rng.EntireRow
Do
Set rng = Cells.FindNext(After:=rng)
If rng.Address = rngStart.Address Then Exit Do
Set rngSource = Application.Union(rngSource, rng.EntireRow)
Loop
With Worksheets("Bremen")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row
If iRow = 1 Then iRow = 2 Else iRow = iRow + 3
rngSource.Copy .Cells(iRow, 1)
.Columns.AutoFit
End With
End Sub