Supprimer les lignes contenants 3 fois la valeur 0 dans des colonnes contigues

Sub suppr()
    Dim r As Range, c As Range, plg As Range
    Dim i As Byte
    With ActiveSheet.Range("A1").CurrentRegion
            For Each r In .Rows
                i = 0
                For Each c In r.Cells
                    i = Array(0, i + 1)(-1 * (c = 0))
                    If i = 3 Then
                        If plg Is Nothing Then Set plg = r Else Set plg = Union(r, plg)
                        Exit For
                    End If
                Next c
            Next r
        If Not plg Is Nothing Then plg.Delete xlShiftUp
    End With
End Sub