Sub SearchSheets()
Dim FirstAddress As String, WhatFor As String
Dim Cell As Range, Sheet As Worksheet
WhatFor = InputBox("Kundennummer eingeben", "Kundennummer")
If WhatFor = Empty Then Exit Sub
For Each Sheet In Sheets
If Sheet.Name <> "SEARCH" Then
With Sheet.Columns(3)
Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlPart)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
Cell.EntireRow.Copy _
Destination:=Sheets("SEARCH").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
End If
End With
End If
Next Sheet
Set Cell = Nothing
End Sub