Sub find_copy()
Dim sh As Worksheet
Dim z&, s%, last&, text$
text = LCase(InputBox("Suchbegriff", "Suche"))
For Each sh In Sheets(Array("Tabelle1", "Tabelle2"))
For z = 1 To sh.Cells(Rows.Count, 1).End(xlUp).Row
For s = 1 To sh.Cells(z, 256).End(xlToLeft).Column
If LCase(sh.Cells(z, s).Value) = text Then
last = Sheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row + 1
sh.Cells(z, s).Copy Sheets("Tabelle3").Cells(last, 1)
End If
Next s
Next z
Next
End Sub
Sub MultiSeek()
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:", "Suche")
For Each wks In Worksheets
Set rng = wks.Cells.Find(what:=sFind, _
lookat:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
If MsgBox("Weiter", vbYesNo + vbQuestion) = vbNo Then Exit Sub
'Hier kannst du den Code einsetzen
'um deine gefunden Werte weiterzuverarbeiten
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub