Bonjour,
Une proposition à étudier.
Cdlt.
Public Sub Delete_Rows_In_Table2()
Dim ws As Worksheet
Dim lo As ListObject
Dim rng As Range, rng2 As Range
Dim LR As ListRow
Dim lCol As Long, lRow As Long
Dim N As Double
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set lo = ws.ListObjects(1)
If lo.DataBodyRange Is Nothing Then exit_Handler
lCol = lo.ListColumns.Count: lRow = lo.ListRows.Count
Set rng = lo.Range.Offset(, 1).Resize(lRow, lCol - 1).SpecialCells(xlCellTypeBlanks)
If rng Is Nothing Then GoTo exit_Handler
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
Next LR
'ws.Unprotect
rng2.Delete
'ws.Protect userinterfaceonly:=True
Set rng2 = Nothing: Set rng = Nothing
exit_Handler:
Set lo = Nothing
Set ws = Nothing
End Sub