Option Explicit
Sub TheBigMergeDestructorAndReanimator()
Dim Lig As Integer
Dim Col As Byte
Dim MergedRange As Range, MergedCell As Range
Dim Plage As Range, Cell As Range
Dim TmpVal As String, MyString As String
Dim x As Byte
Application.ScreenUpdating = False
Set Plage = Range(Range('B11'), Range('C60'))
For Each Cell In Plage
If Cell.MergeCells = True Then
TmpVal = Cell.Value
Set MergedRange = Cell.MergeArea
Cell.MergeCells = False
For Each MergedCell In MergedRange
MergedCell = TmpVal
Next
End If
Next
For Lig = 60 To 11 Step -1#
MyString = ''
For Col = 4 To 11
MyString = MyString & Cells(Lig, Col)
Next
If MyString = '' Then Rows(Lig).Delete
Next
Application.DisplayAlerts = False
For Col = 2 To 3
x = 0
For Lig = 11 To 60
MyString = Cells(Lig, Col)
While MyString = Cells(Lig + x, Col) And Not MyString = ''
x = x + 1
Set MergedRange = Range(Cells(Lig, Col), Cells(Lig + x, Col))
MergedRange.MergeCells = True
Wend
Next Lig
Next Col
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub