Hallo Herr Male,
in Ergänzung zu meinem Schreiben vom 23.02.22 übersende ich einen Code, der genau meinen Vorstellungen entspricht und einwandfrei funktioniert. Vielleicht habt ihr die Möglichkeit, diesen Code an Interessenten zu übermitteln.
Ich bedanke mich hiermit nochfmals für eure Aktivitäten.
Der Code ist folgender:
Private Sub CommandButton6_Click()
' Kopieren aller Zeilen die strSearch=<Suchbegriff> in Spalte B enthalten in das 14. Tabellenblatt
Dim ws As Worksheet, _
rErg As Range, _
strSearch As String, _
StrFirstFound As String, _
iFound As Integer
strSearch = InputBox("wonach wollen Sie suchen?", , "Hendel")
'ACHTUNG 14. Tabellenblatt wird vollständig geleert
ThisWorkbook.Worksheets(14).Cells.ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Index > 1 Then
Set rErg = ws.Range("B7:B600").Find(strSearch)
If Not rErg Is Nothing Then
StrFirstFound = rErg.Address
Do
iFound = iFound + 1
'Ausgabe Fundzeile
rErg.EntireRow.Copy (ThisWorkbook.Worksheets(14).Cells(iFound, 1))
Set rErg = ws.Range("B7:B600").FindNext(rErg)
Loop While Not rErg Is Nothing And rErg.Address <> StrFirstFound
End If
End If
Next ' ws
End Sub
Ich hatte den Code schon vor meiner Anfrage gehabt, er funktionierte nur nicht, da ich einen Schreibfehler hatte und den Suchbereich nicht eingegrenzt hatte. Diesen Fehler bemerkte ich erst heute.
LG Martina
|