Suppression de ligne sous condition Macros VBA

Option Explicit
Const Seuil As Long = #12/1/2015# 'format UK;=1/12/2015 format FR
'--------------------------------
Sub Supprimer_sous_conditions()
Dim Derlig As Integer, T_in, Cptr As Integer
Dim T_date, Cptd As Integer, T_cinq, Cptq As Integer
Dim start As Single

'------------------------initialisations
    start = Timer
    Application.ScreenUpdating = False 'fige l'écran: rapidité, confort
    With ActiveSheet ' plusieurs feuilles
        Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
        T_in = .Range("A2:B" & Derlig)
        ReDim T_date(1 To UBound(T_in))
        ReDim T_cinq(1 To UBound(T_in))
        
'-------------------------Traitements
        For Cptr = 1 To UBound(T_in)
            'Traitement des dates
            If T_in(Cptr, 1) >= Seuil Then
                Cptd = Cptd + 1
                T_date(Cptd) = T_in(Cptr, 1)
            End If
            'traitement des ref
            If T_in(Cptr, 2) Like "5" & "*" Then
                Cptq = Cptq + 1
                T_cinq(Cptq) = T_in(Cptr, 2)
            End If
        Next
'-------------------------Restitution
            'nettoyage
            .Range("A2:B" & 20000).Clear
            'dates
            .Range("A2").Resize(UBound(T_date), 1) = Application.Transpose(T_date)
            .Range("A2:A" & UBound(T_date) - 1).Borders.Weight = xlThin
            'ref
            .Range("B2").Resize(UBound(T_cinq), 1) = Application.Transpose(T_cinq)
            .Range("B2:B" & UBound(T_cinq) - 1).Borders.Weight = xlThin
    End With
    
    Application.ScreenUpdating = True
    MsgBox Derlig & " lignes traitées en " & Timer - start & " sec."
End Sub

For Each cellule In ActiveSheet.UsedRange
    If Left$(cellule.Value, 1) <> "5" Then cellule.EntireRow.Delete
    If IsDate(cellule.Value) And cellule.Value < DateValue("01/12/2015") Then cellule.EntireRow.Delete
Next