Sub MultiSeek()
Dim rng As Range
Dim sFirst As String
Dim sFind As String
Dim wks As Worksheet, neu As Worksheet
Dim lRow As Long
sFind = InputBox("Geben sie das gesuchte Wort oder" & vbLf & _
"den gesuchten Wortteil ein:", "Suchen", "")
If sFind = "" Then Exit Sub
Set neu = Worksheets.Add(before:=Sheets(1))
neu.Name = "Suche_" & Format(Now, "dd.mm.yy_hhmmss")
For Each wks In ThisWorkbook.Sheets
If wks.Name <> neu.Name Then
Set rng = wks.Cells.Find(What:=sFind, LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
sFirst = rng.Address
Do
lRow = lRow + 1
wks.Rows(rng.Row).Copy neu.Cells(lRow, 1)
Set rng = wks.Cells.FindNext(rng)
Loop While rng.Address <> sFirst
End If
End If
Set rng = Nothing
Next
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen