Sub Fusionner()
Dim P As Range, ncol%, i&, j%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.Protect "123", UserInterfaceOnly:=True
Set P = [A3].CurrentRegion 'à adapter
ncol = P.Columns.Count
For i = 2 To P.Rows.Count
For j = ncol To 3 Step -1
If P(i, j) <> "" Then If P(i, j) = P(i, j - 1) Then P(i, j - 1).Resize(, 2).Merge
Next j, i
End Sub
Sub Enlever_fusion()
Dim r As Range
Application.ScreenUpdating = False
ActiveSheet.Protect "123", UserInterfaceOnly:=True
Set r = [A3].CurrentRegion 'à adapter
For Each r In r
With r.MergeArea
If .Count > 1 Then
.UnMerge
r.AutoFill .Cells
End If
End With
Next
End Sub