Die Datei findet ihr hier: https://www.herber.de/bbs/user/24707.xls
Vielen Dank im Vorraus, ihr seid super.
Chris
Sub Verbinden()
Dim rng As Range, i As Integer
Set rng = ThisWorkbook.Sheets("Statusliste (2)").Range("B2")
Do
Do While rng = rng.Offset(i, 0)
i = i + 1
Loop
rng.Offset(0, -1) = rng
Range(rng.Offset(0, -1), rng.Offset(i - 1, -1)).Merge
Set rng = rng.Offset(i, 0)
i = 0
Loop Until rng = ""
End Sub