Suppression de lignes grand tableau, VBA

Sub supprimer()

Dim i As Integer
Application.ScreenUpdating = False

With Sheets("Feuil1")

For i = 1048000 To 1 Step -1
    If (.Cells(i, 2) Mod 10) <> 0 Then
    .Rows(i).Delete
    End If
Next i

End With

Application.ScreenUpdating = True

End Sub 

Option Explicit
Option Base 1

Sub supprimer_si_non10()
Dim Derlig As Long, Dercol As Byte, T_in()
Dim Cptr_in As Long, T_out(), Cptr_out As Long, Col As Byte

Dim start As Single ' A SUPPRIMER APRES ESSAIS
start = Timer ' A SUPPRIMER APRES ESSAIS

'Application.ScreenUpdating = False
With Sheets(1)
     Derlig = .Columns("B").Find("*", , , , , xlPrevious).Row
     Dercol = .Rows(1).Find("*", , , , , xlPrevious).Column
     T_in = .Range(.Cells(2, "A"), .Cells(Derlig, Dercol)).Value
     ReDim T_out(Dercol, 1)
     
     For Cptr_in = 1 To UBound(T_in)
          If T_in(Cptr_in, 2) Mod 10 = 0 Then
               Cptr_out = Cptr_out + 1
               ReDim Preserve T_out(Dercol, Cptr_out)
               For Col = 1 To Dercol
                    T_out(Col, Cptr_out) = T_in(Cptr_in, Col)
               Next Col
          End If
     Next Cptr_in
     '.Range(.Cells(2, "A"), .Cells(Derlig, Dercol)).ClearContents ' A ACTIVER APRES ESSAI
     '.Range("A2").Resize(Cptr_out, Dercol) = Application.Transpose(T_out) ' A ACTIVER APRES ESSAI
End With

With Sheets(2) ' A SUPPRIMER APRES ESSAIS
     .Range("A2").Resize(Cptr_out, Dercol) = Application.Transpose(T_out) ' A SUPPRIMER APRES ESSAIS
     .Select ' A SUPPRIMER APRES ESSAIS
End With ' A SUPPRIMER APRES ESSAIS

MsgBox "traitement réussi en : " & Timer - start & " .secondes" ' A SUPPRIMER APRES ESSAIS
End Sub