Volltextsuche läuft nicht korrekt

Private Sub CommandButton1_Click()
'Sheets("Suche").UsedRange.Clear
On Error Resume Next
Dim oWS As Worksheet
Dim rngUnion As Range, rngFund As Range
Dim strErste$, strSuchBegriff$
Dim MaxRow As Long
Dim WS_Suche As Worksheet
'Tabelle für die Auflistung
Set WS_Suche = Sheets("Suche")
Such_Formular.CommandButton1.Visible = False
strSuchBegriff = Such_Formular.TextBox1.Value
If StrPtr(strSuchBegriff) = 0 Then
Exit Sub
End If
MaxRow = 1
Sheets("Suche").UsedRange.Clear
For Each oWS In ThisWorkbook.Worksheets
If oWS.Name  WS_Suche.Name Then
Set rngFund = oWS.UsedRange.Find(strSuchBegriff, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not rngFund Is Nothing Then
Set rngUnion = Intersect(oWS.UsedRange, oWS.Rows(rngFund.Row))
strErste = rngFund.Address
Set rngFund = oWS.UsedRange.FindNext(rngFund)
Do While strErste  rngFund.Address
Set rngUnion = Union(Intersect(oWS.UsedRange, oWS.Rows(rngFund.Row)), rngUnion)
Set rngFund = oWS.UsedRange.FindNext(rngFund)
Loop
End If
If Not rngUnion Is Nothing Then
For Each rngUnion In rngUnion.Areas
rngUnion.Copy WS_Suche.Cells(MaxRow, 1)
MaxRow = MaxRow + rngUnion.Rows.Count
Next rngUnion
Set rngUnion = Nothing
End If
End If
Next oWS
If MaxRow > 1 Then
Such_Formular.CommandButton3.Visible = True
Else
Such_Formular.CommandButton3.Visible = False
End If
Such_Formular.TextBox1.Text = ""
End Sub