Sub Defusionne()
Dim i&
Application.ScreenUpdating = False
With Feuil1 'CodeName
With .Range("A1", .UsedRange)
For i = 7 To .Rows.Count
With .Cells(i, 2).MergeArea
If .Count > 1 Then .UnMerge: .Value = .Cells(1)
End With
With .Cells(i, 3).MergeArea
If .Count > 1 Then .UnMerge: .Value = .Cells(1)
End With
Next
End With
End With
End Sub