Suppression Ligne

merci d'avance

Bonjour,

Voici un essai :

Sub supp()

dim dl&
dim rsupp as range

dl = cells(rows.count, 1).end(xlup).row

for i = 2 to dl
    if application.countif(range("A" & i & ":E" & i), 0) > 0 then
        if rsupp is nothing then set rsupp = rows(i)
        if i = 2 then
            set rsupp = rows(i & ":" & i+1)
        else
            set rsupp = union(rsupp, rows(i-1 & ":" & i+1))
        end if
    end if
next i

if not rsupp is nothing then rsupp.delete xlshiftup

end sub

Cdlt,

Salut Guellila,
Salut 3GB,

un double-clic sur la feuille démarre la macro...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tRow()
'
Cancel = True
Application.ScreenUpdating = False
ReDim tRow(1 To UsedRange.Rows.Count + 1)
'
For x = UsedRange.Rows.Count To 2 Step -1
    If WorksheetFunction.CountIf(Rows(x), "0") > 0 Then _
        tRow(x) = 1: _
        tRow(x + 1) = 1: _
        If x > 2 Then tRow(x - 1) = 1
Next
For x = UBound(tRow) To 2 Step -1
    If tRow(x) = 1 Then Rows(x).Delete shift:=xlUp
Next
'
Application.ScreenUpdating = True
'
End Sub

A+