Microsoft 365 suppression de ligne si condition (vba)

If Cells(I, 17) <> 3 Then Cells(I, 1).EntireRow.Delete

Sub EntireRow()
Application.ScreenUpdating = False
Dim I As Integer
     For I = Range("Q" & Rows.Count).End(xlUp).Row To 1 Step -1
             If Cells(I, 17) <> 3 Then Cells(I, 1).EntireRow.Delete
     Next I
End Sub

Sub SuppLignes()
T0 = Timer  ' A supprimer, juste pour mesurer le temps
    Application.ScreenUpdating = False                  ' On fige l'écran
    DL = [Q65000].End(xlUp).Row                         ' Dernière ligne de Résultat
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion colonne en A
    f = "=SI(R2<>3;CAR(1);0)"                           ' Formule utilisée
    With Range("A2:A" & DL)                             ' Plage où coller la formule qui sera triée, dernière colonne qui peut toujours être utilisée XFD
        .FormulaLocal = f                               ' Coller formule
        .EntireRow.Sort .Cells, xlDescending            ' Tri pour regrouper et accélérer
        .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete  ' Suppression des lignes concernées
        .Delete Shift:=xlToLeft                         ' Effacement colonne formules
    End With
    Columns.AutoFit                                     'Ajustement largeurs colonnes
    With ActiveSheet.UsedRange: End With                'Ajustement barres de défilement
MsgBox Timer - T0  ' A supprimer
End Sub

Sub DeleteRows()
    Dim i As Long
    Dim RangeDelete As Range
  
    With ActiveSheet
        For i = .UsedRange.Row To .UsedRange.Row + .UsedRange.Rows.Count - 1
            If Cells(i, "Q") <> 3 Then
                If RangeDelete Is Nothing Then
                    Set RangeDelete = Rows(i)
                Else
                    Set RangeDelete = Union(RangeDelete, Rows(i))
                End If
            End If
        Next i
    End With
  
    If Not RangeDelete Is Nothing Then RangeDelete.Delete
End Sub