Excel VBA – Endloses Suchen eines Eintrages in einer Spalte abbrechen und Prozedur für die andern Ei

[MSCom]

In einem Excel-Arbeitsblatt habe ich In der Spalte B ab Zeile 6 Zeilen mit AAAA und CCCC. Die Anzahl der Zeilen sind unterschiedlich.
AAAA
AAAA
AAAA
CCCC
CCCC
CCCC
CCCC
CCCC

Mit dem nachstehenden Markro soll für AAAA, BBBB, CCCC eine Prozedur durchgeführt werden. BBBB ist vorläufig in der Spalte B noch nicht aufgeführt. Wenn ich das Makro ausführe, so sucht es BBBB endlos und macht keine Rückmeldung, d.h. ich muss das Excel im Task-Manager beenden. Wie kann ich machen, dass wenn BBBB in der Spalte B nicht vorhanden ist, die Prozedur nicht endlos nach BBBB sucht sondern zur nächsten Prozedur für CCCC geht und das Makro bis zu End Sub durchläuft und durchführt.

Private Sub Tabelle1_Click()
Sheets("Tabelle1").Select
Application.Goto Reference:="R1C2"
Do Until ActiveCell.Text = "AAAA"
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
ActiveCell.Rows("1:2").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(2, 1).Range("A1").Select
Selection.Copy
ActiveCell.Offset(-1, 1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -1).Range("A1").Select
Sheets("Tabelle1").Select
Application.Goto Reference:="R1C2"
Do Until ActiveCell.Text = "BBBB"
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
ActiveCell.Rows("1:2").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(2, 1).Range("A1").Select
Selection.Copy
ActiveCell.Offset(-1, 1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -1).Range("A1").Select
Sheets("Tabelle1").Select
Application.Goto Reference:="R1C2"
Do Until ActiveCell.Text = "CCCC"
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
ActiveCell.Rows("1:2").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(2, 1).Range("A1").Select
Selection.Copy
ActiveCell.Offset(-1, 1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -1).Range("A1").Select
End Sub