Gefunden String in erste Zeile der Spalte

Sub Suche()
Dim rng As Range
Dim sBegriff As String, sAddress As String
sBegriff = Trim(ActiveCell.Value)
Tabelle5.Activate
If sBegriff = "" Then Exit Sub
Set rng = Columns("A:H").Find( _
What:=sBegriff, _
Lookat:=xlWhole, _
LookIn:=xlValues, _
MatchCase:=False, _
After:=Cells(Rows.Count, 8))
If rng Is Nothing Then
Beep
MsgBox "Suchbegriff nicht gefunden!", , _
Application.UserName
Exit Sub
End If
sAddress = rng.Address
rng.Select  '------ hier geaendert offset raus--------------------
If (MsgBox(rng.Address(False, False), vbYesNo, "Weitersuchen?")) = vbYes Then
rng.Select
Do
Columns("A:H").FindNext(After:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then Exit Sub
If (MsgBox(ActiveCell.Address(False, False), vbYesNo, "Weitersuchen?")) = vbNo Then Exit Do
Loop
End If
End Sub