Sub SupprimeLignesAvec0()
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim FirstLig&
Dim NbLig&
Dim i&
'---
ActiveSheet.Copy After:=Sheets(ActiveSheet.Name)
Set S = ActiveSheet
Set R = S.UsedRange
R.Copy
R.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'---
FirstLig& = R.Cells(1, 1).Row
NbLig& = R.Rows.Count
Application.ScreenUpdating = False
For i& = FirstLig& + NbLig& To FirstLig& Step -1
Set C = R.Cells(i&, 3)
If Not IsError(C) Then
If Not IsEmpty(C) And C = 0 Then
S.Rows(C.Row).Delete
End If
End If
Next i&
R.Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub