trier des données, par colonne, pour chaque année

Sub tri_annee()
Dim Annees As Object, Cel As Range
Dim It
Application.ScreenUpdating = False
Set Annees = CreateObject("Scripting.Dictionary")
Range("B1:IV1000").ClearContents
Range("A1:A" & [A65000].End(xlUp).Row).Name = "base"
Range("A2:A" & [A65000].End(xlUp).Row).Name = "base2"
For Each Cel In [base2]
    If Not Annees.Exists(Year(Cel)) Then Annees.Add Year(Cel), Year(Cel)
Next Cel
For Each It In Annees.Items
    With [IV1].End(xlToLeft)
        x = .Offset(0, 2).Resize(2, 1).Address
        y = .Offset(0, 1).Address
        Range(y).Value = [A1]
        .Offset(1, 2).FormulaR1C1 = "=YEAR(RC1)=" & It
        Range("base").AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range(x), CopyToRange:=Range(y)
        Range(y) = It
    End With
Next It
Range(x).ClearContents
End Sub

Sub tri_annee()
Dim Annees As Object, Cel As Range
Dim It
Application.ScreenUpdating = False
Set Annees = CreateObject("Scripting.Dictionary")
Range("B1:IV1000").ClearContents
Range("A1:A" & [A65000].End(xlUp).Row).Name = "base"
Range("A2:A" & [A65000].End(xlUp).Row).Name = "base2"
For Each Cel In [base2]
    If Not Annees.Exists(Year(Cel)) Then Annees.Add Year(Cel), Year(Cel)
Next Cel
'Conversion du dictionnary en array
aItems = Annees.Items
z = UBound(aItems)
For i = z - 2 To z
    It = aItems(i)
    With [IV1].End(xlToLeft)
        x = .Offset(0, 2).Resize(2, 1).Address
        y = .Offset(0, 1).Address
        Range(y).Value = [A1]
        .Offset(1, 2).FormulaR1C1 = "=YEAR(RC1)=" & It
        Range("base").AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range(x), CopyToRange:=Range(y)
        Range(y) = It
    End With
Next i
Range(x).ClearContents
End Sub