Suche exakten Listboxeintrag

Private Sub CommandButton7_Click()
Application.ScreenUpdating = False
Sheets("Tabelle2").Activate
With ActiveSheet.Range("A:A")
Set found = .Find(UserForm1.TextBox2.Text)
If Not found Is Nothing Then
ErsterTreffer = found.Address
zeile = found.Row
If found.Row > zeile Then zeile = found.Row
End If
UserForm1.ListBox2.ColumnCount = 2
UserForm1.ListBox2.ColumnWidths = "85;350"
UserForm1.ListBox2.Clear
i = 0
Do
UserForm1.ListBox2.AddItem .Cells(found.Row, 1).Value
UserForm1.ListBox2.Column(1, i) = .Cells(found.Row, 2).Value
i = i + 1
Set found = .FindNext(After:=found)
If found.Address = ErsterTreffer Then Exit Do
Loop
Sheets("Tabelle1").Activate
Application.ScreenUpdating = True
End With
fehler:
End Sub