Verbinden gleicher Werte in Spalte

Sub VerbindenIdentischeWerte()
Dim Zeile As Long
Dim Zelle1 As Range
Dim Zelle2 As Range
Dim rngZeile As Range
Dim sp As Long
Dim Verbinden As Boolean
Zeile = 1
Set rngZeile = Intersect(ActiveSheet.UsedRange, Rows(Zeile))
Set Zelle1 = rngZeile.Cells(1, 1)
For sp = 2 To rngZeile.Columns.Count + 1
If rngZeile.Cells(1, sp) = Zelle1 Then
Verbinden = True
Else
With Range(Zelle1, rngZeile.Cells(1, sp - 1))
If Verbinden = True Then
.Offset(0, 1).Resize(1, .Columns.Count - 1).ClearContents
.Merge
End If
.BorderAround Weight:=xlThin
.HorizontalAlignment = xlCenter
End With
Verbinden = False
Set Zelle1 = rngZeile.Cells(1, sp)
End If
Next
End Sub