XL 2010 Supprimer lignes

Bonjour le Forum

Existe t'il une solution plus rapide que :

Application.Calculation = xlManuel
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim i As Long
With Sheets("Feuil1")
For i = .Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
On Error Resume Next
If Sheets("Feuil1").Range("S" & i) = 0 Then
Sheets("Feuil1").Range(i & ":" & i).Resize(, 19).Delete Shift:=xlUp
End If
Next
End With

Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Pour supprimer des lignes contenant "0" en colonne S sur 10000 lignes
si il y a par ex 4000 "0"
voir fichier joint

Merci