Sub TestIt()
Dim wshZiel As Worksheet
Dim wshSuch As Worksheet
Dim rngZiel As Range, c As Range
Dim strKdnr As String, strAddi As String
strKdnr = InputBox("Kundennummer")
If Len(Trim(strKdnr)) = 0 Then Exit Sub
Set wshZiel = Sheets("Zusammenfassung")
Set rngZiel = wshZiel.Cells(Rows.Count, 1).End(xlUp)
Set rngZiel = rngZiel.Offset(1, 0)
For Each wshSuch In ActiveWorkbook.Sheets
If wshSuch.Index <> wshZiel.Index Then
With wshSuch.UsedRange.Columns(3)
Set c = .Find(strKdnr)
If Not c Is Nothing Then
strAddi = c.Address
Do
wshSuch.Rows(c.Row).Copy Destination:=rngZiel
rngZiel.Offset(0, 5).Value = wshSuch.Name
Set rngZiel = rngZiel.Offset(1, 0)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> strAddi
End If
End With
End If
Next wshSuch
End Sub