Sub MultiSeek()
'Suchbegriff über mehrere Arbeitsmappen suchen
'von Hans Herber
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Suchtext eingeben:", "Suche", "Suchtext")
If sFind = "" Then Exit Sub
For Each wks In Worksheets
Set rng = wks.Cells.Find( _
what:=sFind, _
lookat:=xlWhole, _
LookIn:=xlValues)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
'wks.Activate
Application.GoTo rng, False
If MsgBox( _
prompt:=sFind & ": wurde in " & wks.Name & " gefunden:" & vbLf & vbLf & _
"[ " & Cells(rng.Row, 1) & " ] [ " & Cells(rng.Row, 2) & " ] [ " & _
Cells(rng.Row, 3) & " ] [ " & Cells(rng.Row, 4) & " ]", _
Buttons:=vbRetryCancel + vbQuestion _
) = vbCancel Then Exit Sub
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Next wks
MsgBox prompt:="Suche nach "" " & sFind & " "" wurde beendet!", _
Buttons:=vbOKOnly + vbExclamation
End Sub
Gruß Sepp
Ein kluger Mann macht nicht alle Fehler selbst.
Er lässt auch anderen eine Chance.
(Sir Winston Churchill)