Hallo Forum,

ich habe folgenden Code, der soweit funktioniert aber nicht ganz wie er sollte, nun weiß ich nicht wie ich den umbauen kann.

Der Code sucht mit einen oder mehrere Begriffe die in einer ListBox markiert wurden in einem bestimmten Tabellenblatt (Bsp. Tabelle1), wenn der Begriff gefunden wurde, kopiert der Code auf ein anderes Tabellenblatt (Tabelle2) die Zelle unter dem gefundenen Begriff.


Was ich allerdings bräuchte wäre das der Code nicht ein bestimmtes Tabellenblatt durchsucht sondern alle außer ein bestimmtes.
Sollte der Begriff gefunden worden sein, sollen alle gefüllten Zellen darunter kopiert werden und in ein bestimmtes Tabellenblatt eingefügt werden.
Wenn ein zweiter Begriff gesucht wird, sollten die kopierten Zellen unter den bereits kopierten Zellen eingefügt werden.


Dim rZelle As Range
Dim sFundst As String
Dim sSuchbegriff As String
Dim ws As Worksheet

For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then
sSuchbegriff = ListBox1.List(i - 1)

If Trim(sSuchbegriff) = "" Then Exit Sub

With ThisWorkbook.Worksheets("Tabelle1").Cells
Set rZelle = .Find(What:=sSuchbegriff, LookAt:=xlPart, LookIn:=xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
ThisWorkbook.Worksheets("Tabelle2").Range("A1").Value = _
.Cells(rZelle.Row + 1, rZelle.Column).Value
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address <> sFundst
Else
MsgBox "Der Begriff """ & sSuchbegriff & """ wurde nicht gefunden.", _
48, " Hinweis für " & Application.UserName
End If
End With
End If
Next i


Kann mir jemand helfen?

Danke schon mal im Voraus

Grüße
Eierkopf