Sub hb() Dim n n = 3 For i = 3 To 18 If Range("b" & i) <> Range("b" & i + 1) Then Range("b" & n & ":b" & i).Merge n = i + 1 End If Next End Sub