Ich suche in Spalte 3 nach allen Zeilen eines Begriffs, bei dessen Zeile ich dann einen Eintrag vornehmen will. Das habe ich bis jetzt *gebastelt". Die Suche geht aber nicht weiter, das heisst es findet immer die gleiche Zeile. Was stimmt nicht?
Die Variablen habe ich deklariert.
Sub Suche_Begriff_starten()
Application.ScreenUpdating = False
Application.EnableEvents = False
'---Fehlerprüfung bei falscher Schreibweise
On Error GoTo out
If Begriff = "" Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Worksheets(1).Select
intLastRow = Cells(Rows.Count, Spalte).End(xlUp).Row
Set Bereich = Range(Cells(1, Spalte), Cells(intLastRow, Spalte))
For Each z In Bereich
Set SuBe = Bereich.Find(Begriff, LookAt:=xlWhole)
If Not SuBe Is Nothing Then
SuBe.Select
Zeile = SuBe.Row
Application.GoTo SuBe, True
Workbooks("Muster").Worksheets(1).Cells(Zeile, 1).Value = Workbooks("Quelle"). _
Worksheets(1).Cells(1, 1)
Else
MsgBox Prompt:="Der Begriff " & Begriff & " nicht gefunden." _
& vbNewLine & vbNewLine _
& "Bitte Schreibweise überprüfen und Suche wiederholen", _
Title:=" Hinweis für " & Application.UserName
Worksheets(1).Activate
usrBegriffSuchen.Show
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
End If
Next
Set SuBe = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
out:
MsgBox Prompt:="Fehler Nummer " & Err.Number & " ist aufgetreten" _
& vbNewLine & "(" & Err.Description & ")" _
& vbNewLine & vbNewLine & "Die Ausführung wird beendet" _
& vbNewLine & "Wenden Sie sich an den Ersteller Gregor Wüest", _
Title:=" Fehlermeldung"
Worksheets(1).Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Vielen Dank
Gregor