AW: Kopier-Makro
15.03.2005 08:32:41
opaharry
Bei diesem Makro werden die gefundenen Zeilen die den Suchbegriff enthalten in ein neu erstelltes Blatt kopiert.Kannste ja eventuell anpassen.
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