Sub fusion()
With Sheets(1)
lig = .Range("B" & Rows.Count).End(xlUp).Row - 1
r = 1
Do
i = 0
Do
If .Cells(r + i + 1, 2) = "" Then i = i + 1
Loop While .Cells(r + i + 1, 2) = ""
.Range(.Cells(r, 2), .Cells(r + i, 2)).Merge
r = r + 1
Loop While r < lig
End With
End Sub