Supprimer lignes vides

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

Cliquez pour agrandir...