Sub SearchNames()
Dim rng As Range, rngSource As Range, rngStart As Range
Dim varInput As Variant
Dim iRow As Integer
varInput = Application.InputBox( _
prompt:="Absender", _
Title:="Suchen", _
Default:="Suchbegriff", _
Left:=263, _
Top:=169, _
Type:=2)
If varInput = False Then Exit Sub
Set rng = ActiveSheet.Columns("D").Find( _
what:=varInput, lookat:=xlWhole, LookIn:=xlValues)
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("Suchergebniss")
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