Per InputBox suchen & Werte ausgeben

Sub Suche_Namen()
Dim iIndex%, strSuch_Name$
strSuch_Name = InputBox("Geben Sie den Namen ein den Sie suchen möchten", "Name Suchen")
If StrPtr(strSuch_Name) = 0 Then Exit Sub
With Worksheets(1)
.Range("A2", .Cells(.Rows.Count, .UsedRange.Columns.Count)).ClearContents
End With
For iIndex = 2 To Worksheets.Count
Find_And_Copy Worksheets(iIndex).Columns(1), strSuch_Name
Next
End Sub
Sub Find_And_Copy(rngBereich As Range, strSuch_Name$)
Dim sErste$, rngCell As Range
Set rngCell = rngBereich.Find(What:=strSuch_Name, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rngCell Is Nothing Then
sErste = rngCell.Address
With Worksheets(1)
Do
rngCell.EntireRow.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
Set rngCell = rngBereich.FindNext(rngCell)
Loop While sErste  rngCell.Address
End With
End If
End Sub