Sub Fusion()
Dim debut As Range, i&
With ActiveSheet.UsedRange
Set debut = .Cells(1)
For i = 1 To .Rows.Count
If .Cells(i, 1).Borders(xlEdgeBottom).LineStyle <> xlNone Then
Range(debut, .Cells(i, 1)).Merge
Set debut = .Cells(i + 1, 1)
End If
Next
End With
End Sub