Private Sub CommandButton1_Click()
Dim strSuche As String
Dim strFirst As String
Dim c As Range
Dim lngAnz As Long
strSuche = TextBox1.Text
If strSuche <> "" Then
With Worksheets("Tabelle1")
Set c = .Columns(1).Find(strSuche, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
strFirst = c.Address
Do
ListBox1.AddItem c.Value
lngAnz = ListBox1.ListCount
ListBox1.List(lngAnz - 1, 1) = .Cells(c.Row, 5).Value
Set c = .Columns(1).FindNext(c)
Loop While Not c Is Nothing And c.Address <> strFirst
End If
End With
End If
End Sub