Supprimer des données avec conditions

Bonjour à tous.

Je suis actuellement en Nouvelle Calédonie pour mon stage de fin d'étude en hydrologie.

J'ai un grand nombre de donnée provenant de pluviomètre à traiter. Pour accélérer les manipulations, j'ai voulu créer un code me permettant de supprimer les lignes contenant des 0 si il y en avait 10 ou plus à la suite. Après l'aide précieuse d'une personne j'ai obtenu le code suivant:

Sub test()
    Dim i As Long               'Indice de boucle
    Dim DerniereLigne As Long   'Pour stocker le numero de la derniere ligne
    Dim NBzero As Long          'compteur pour les zero
    Application.ScreenUpdating = False
        With ThisWorkbook.Sheets("Feuille_01")
            DerniereLigne = .Cells(Rows.Count, 1).End(xlUp).Row
            For i = DerniereLigne To 1 Step -1
                If .Cells(i, 3) = 0 Then
                    NBzero = NBzero + 1
                Else
                    If NBzero >= 10 Then
                        .Rows(i + 1 & ":" & i + NBzero).Delete Shift:=xlUp
                        .Rows(i + 1).Insert Shift:=xlDown
                        NBzero = 0
                    End If
                End If
            Next i
        End With
    Application.ScreenUpdating = True
End Sub

Qui est à appliquer sur le tableur en PJ.

Pour être sur que le traitement était valable, j'ai fait un traitement manuel. Et je me suis rendu compte en comparant les deux résultats que le traitement par le code supprimait des lignes avec des valeurs différentes de 0, je vous met en PJ une capture d'écran avec a gauche le traitement manuel et a droite le traitement par le code.

Je ne comprend pas pourquoi le code ne fonctionne pas. Je viens donc vous demander votre aide.

Merci d'avance

Bonjour,

il serait plus facile pour moi si vous pourriez mettre le résultat attendu sur le l'onglet 2, merci!

Bonjour,

Sub test()
    Dim i As Long               'Indice de boucle
    Dim DerniereLigne As Long   'Pour stocker le numero de la derniere ligne
    Dim NBzero As Long          'compteur pour les zero
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("Feuille_01")
        DerniereLigne = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = DerniereLigne To 1 Step -1
            If .Cells(i, 3) = 0 Then
                NBzero = NBzero + 1
            Else
                If NBzero >= 10 Then
                    .Rows(i + 1 & ":" & i + NBzero).Delete Shift:=xlUp
                    .Rows(i + 1).Insert Shift:=xlDown
                End If
                NBzero = 0
            End If
        Next i
    End With
End Sub

Cordialement.