Suppression de lignes sur plusieurs tableau

RE,

Une dernière tentative, qui j'espère sera la bonne.

Cdlt.

Option Explicit

Public Sub Delete_Rows_In_Multiple_Tables()
Dim lo As ListObject
Dim rng As Range, rng2 As Range
Dim LR As ListRow
Dim lCol As Long
Dim N As Double
    Application.ScreenUpdating = False
    For Each lo In ActiveSheet.ListObjects
        If lo.InsertRowRange Is Nothing Then
            lCol = lo.ListColumns.Count
            On Error Resume Next
            Set rng = lo.DataBodyRange.Offset(, 1).Resize(, lCol - 1) _
                      .SpecialCells(xlCellTypeBlanks)
            On Error GoTo 0
            If Not rng Is Nothing Then
                Set rng = Nothing
                For Each LR In lo.ListRows
                    Set rng = LR.Range.Offset(, 1).Resize(1, lCol - 1)
                    N = WorksheetFunction.CountA(rng)
                    If N = 0 Then
                        If rng2 Is Nothing Then
                            Set rng2 = LR.Range
                        Else
                            Set rng2 = Union(LR.Range, rng2)
                        End If
                    End If
                    Set rng = Nothing
                Next LR
            End If
        End If
        If Not rng2 Is Nothing Then
            rng2.Delete
            Set rng2 = Nothing
        End If
    Next lo
End Sub

Parfait Merci

Rechercher des sujets similaires à "suppression lignes tableau"