Microsoft 365 suppression des lignes d'un sous-total à 0

Sub Supprimer_sous_totaux_nuls()
Dim t, colref%, P As Range, tablo, deb&, i&, v, j
t = Timer
colref = 2 'colonne de référence, à adapter
Set P = [A1].CurrentRegion
Application.ScreenUpdating = False
P(1).EntireColumn.Insert 'insère une colonne auxiliaire
With Range(P.Columns(0), P)
    tablo = .Formula 'matrice des formules, plus rapide
    deb = 2
    '---analyse des lignes et repérages---
    For i = 2 To UBound(tablo)
        If tablo(i, colref + 1) Like "*SUBTOTAL*" Then
            v = P(i, colref)
            For j = deb To i
                tablo(j, 1) = IIf(v = 0, "#N/A", 1) 'repère
            Next j
            deb = j
        End If
    Next i
    '---restitution, tri et suppression---
    .Columns(1) = tablo
    .Sort .Cells(1), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    .Columns(1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
    P(1, 0).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
MsgBox Format(UBound(tablo) - P.Rows.Count, "#,##0") & " lignes supprimées en " & Format(Timer - t, "0.00 \sec")
End Sub