XL 2016 Filtre avancé sur date en vba

Sub Worksheet_Activate()
    Application.ScreenUpdating = False                          ' Ecran figé
    Range("A2:G" & Range("A65500").End(xlUp).Row).ClearContents ' Efface matrice de sortie
    DL = Sheets("BASE").Range("A65500").End(xlUp).Row           ' Dernière ligne de Base
    Range("A1:G" & DL) = Sheets("BASE").Range("A1:G" & DL).Value ' Copie tableau en valeur
    With ActiveSheet.UsedRange
        .Columns(2).EntireColumn.Insert                         'Insère une colonne auxiliaire
        With .Columns(2)
            .FormulaR1C1 = "=IF(RC[6]<TODAY(),1,"""")"          ' Insère formule, 1 si < aujourd'hui
            .Value = .Value                                     ' Supprime les formules
            .EntireRow.Sort .Cells, xlDescending                'Tri pour regrouper et accélérer
            On Error Resume Next                                'Si aucune SpecialCell
            .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete ' Suprime les lignes < aujourd'hui
            .EntireColumn.Delete                                'Supprime la colonne auxiliaire
        End With
    End With
    With ActiveSheet.UsedRange: End With                            'Actualise les barres de défilement
End Sub

Sub ECHEANCES_A_VENIR()
    Dim plage
    Feuil2.Cells.Clear
    Set plage = Feuil1.UsedRange
    plage.AutoFilter Field:=7, Criteria1:=">" & Date * 1
    plage.SpecialCells(xlCellTypeVisible).Copy Feuil2.[a1]
    plage.AutoFilter
End Sub

Sub Filtre_Avancé_OK()
Dim Criteres As Range
Set Criteres = Range("'ECHEANCES A VENIR'!I1:I2") ' définition plage critères
'On applique le filtre avancé
Sheets("BASE").Range("A1:G11").AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Criteres, _
    CopyToRange:=Range("'ECHEANCES A VENIR'!Extract"), _
    Unique:=False
End Sub

Sub Filtre_Avancé_OK_bis()
Dim vBase As Range, Criteres As Range, Recopie As Range
With Sheets("BASE")
    Set vBase = Range(.Cells(1), .Cells(Rows.Count, "G").End(xlUp))
End With
With Sheets("ECHEANCES A VENIR")
    Set Criteres = .[I1:I2] ' définition plage critères
    Set Recopie = .[A1:G1] 'définition plage de recopie
End With
'On applique le filtre avancé
vBase.AdvancedFilter xlFilterCopy, Criteres, Recopie, False
End Sub