Hallo Ramona, Laura etc. pp,  ;o)

dein Code ist nicht direkt falsch, aber auch nicht 100%ig korrekt. ;)

Also dann mal einige Anmerkungen:

--------

Du gehst z.B. in deiner zweiten Schleife (Schleife b) von einer festen Iteration aus, als würdest du die Anzahl der verbleibenden Einträge kennen. Das ist aber oftmals nicht der Fall.

--------

Es gibt unterschiedliche Methoden um das Ende einer Spalte zu ermitteln. Deine funktioniert zwar (auch hier gehst du jedoch von einer maximalen Anzahl aus) ist aber umständlich.

1. Von oben nach unten, bis die erste leere Zelle kommt (entspr. STRG+PfeilNachUnten)

Set cell = Range("B1").End(xlDown)

2. Von unten nach oben, bis die erste nicht-leere Zelle kommt (diese ist oftmals die verwendete, wenn in der Spalte zwischen Daten leere Zellen vorkommen)

Set cell = Cells(Rows.Count,"B").End(xlUp)

--------

Über das unnötige Select will ich mich hier nicht weiter äußern. Dazu gibt es im Internet genug Lesestoff (z.B. hier) warum man das nicht benutzen sollte. ;) Diese existieren nur, und machen Sinn, wenn man dem Benutzer etwas signalisieren will. Für die Verarebeitung im Code, sind sie nicht notwendig.

Und da kommen wir zu ...

Ich will dir mal eine andere Variante davon vorstellen. Eine, die ganz anders aussieht, aber das gleiche tut. (damit will ich Dir nur zeigen, dass es stets mehrere Wege zum Ziel gibt und nicht DIE Lösung)

Anmerkung zum Code: Die Ausgabe erfolgt im Direktfenster. Dieses muss man - das erste mal - selber einblenden, denn es wird nicht standardmäßig angezeigt. Das bewerkstelligt man mittels STRG+G oder über das Menü Ansicht.

Option Explicit 'erzwingt die Deklaration von genutzten Variablen

Sub Test3()
  
  Dim cellStart   As Excel.Range
  Dim cellEnd     As Excel.Range
  Dim cell        As Excel.Range
  
  Set cell = Worksheets("Kollision").Range("B1") 'die erste zu berachtende Zelle referenzieren
  Set cellStart = cell 'diese Zelle ist dann auch logischer Weise auch der Anfang des ersten Bereichs
  
  Debug.Print "# Beginn - Schleife #"
  
  Do Until Trim$(cell.Value) = "" '>solange bis< Zelleninhalt >gleich< leer ist
    
    If Not cellEnd Is Nothing Then
      Set cellStart = cell
      Set cellEnd = Nothing
    End If
    
    'Inhalt der aktuellen Zelle und der Zelle darunter verschieden?
    '  1. Variante unterscheidet zwischen Groß-/Kleinschreibung
    'If cell.Value <> cell.Offset(1).Value Then
    '  2. Variante unterscheidet nicht zwischen Groß-/Kleinschreibung
    If 0 <> StrComp(cell.Value, cell.Offset(1).Value, vbTextCompare) Then
    'ja -> also findet hier ein wechsel statt
      
      Set cellEnd = cell
      
      Debug.Print " + Wechsel zwischen den Zellen: " & cell.Address(0, 0) & " ('" & cell.Value & "')" & _
                                             " und " & cell.Offset(1).Address(0, 0) & " ('" & cell.Offset(1).Value & "')"
      
      Debug.Print " >> Dessen vollständige Bereich lautet: " & cellStart.Address(0, 0) & ":" & cellEnd.Address(0, 0)
      
    End If
    
    'die Zelle unter der aktuell referenzierten Zelle referenzieren
    Set cell = cell.Offset(1)
  Loop
  
  Debug.Print "# Ende - Schleife #"
  
End Sub

Gruß