Sub Fusion()
Dim i As Long, LigneDeb As Long, LigneFin As Long, Maxi As Long, Valeur
LigneDeb = 1
Valeur = Range("A1").Value
Maxi = ActiveSheet.Range("A65536").End(xlUp).Row
For i = 1 To Maxi + 1
If Range("A" & i).Value <> Valeur Or i = Maxi + 1 Then
Application.DisplayAlerts = False
Range("A" & LigneDeb & ":A" & i - 1).Merge
Application.DisplayAlerts = True
LigneDeb = i
Valeur = Range("A" & i).Value
End If
Next i
End Sub