Fichier Excel : Retenir les dates les plus récentes par millésimes

Sub essai()
Application.ScreenUpdating = False
Dim tablign()
Dim coll As Collection
Set coll = New Collection
For n = 1 To Range("K65536").End(xlUp).Row
   If IsDate(Range("K" & n)) Then
     On Error Resume Next
       coll.Add Year(Range("K" & n)), CStr(Year(Range("K" & n)))
     On Error GoTo 0
   End If
Next n
ReDim tablign(1 To coll.Count)
For n = 1 To coll.Count
  For m = 1 To Range("K65536").End(xlUp).Row
    If IsDate(Range("K" & m)) Then
     If Year(Range("K" & m)) = coll(n) And tablign(n) < Range("K" & m) Then
      tablign(n) = Range("K" & m)
     End If
    End If
  Next m
Next n
For n = 1 To coll.Count
 For m = Range("K65536").End(xlUp).Row To 3 Step -1
   If Year(Range("K" & m)) = Year(tablign(n)) And Range("K" & m) <> tablign(n) Then Rows(m).Delete
 Next m
Next n
[COLOR=blue]Range("A3:O" & Range("A65536").End(xlUp).Row).Sort Key1:=Range("K3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom[/COLOR]
Application.ScreenUpdating = True
End Sub

Option Explicit
Private Sub CommandButton1_Click()
  Dim Tablo(), Tableau() [COLOR=SeaGreen]'colonne K, contenus retenus[/COLOR]
  Dim Derli As Long, X As Long, N As Long, I As Integer, Li As Long, L As Long

  Derli = [K65536].End(xlUp).Row
  Range("A3:O" & Derli).Sort Key1:=Range("K3"), Order1:=xlAscending
  Application.DisplayAlerts = False
 [COLOR=SeaGreen] 'Ajout d'une feuille "Base" copie de la première[/COLOR]
  ActiveSheet.Copy after:=ActiveSheet
  ActiveSheet.Name = "Base"
[COLOR=SeaGreen] 'construction du tableau des lignes gardées jusqu'à l'avant-dernière année[/COLOR]
 ReDim Tablo(Derli + 1)
  For N = 0 To Derli
    Tablo(N) = Cells(N + 3, "K")
    Tablo(N + 1) = Cells(N + 4, "K")
    If Year(Tablo(N + 1)) > Year(Tablo(N)) Then
      I = I + 1
      ReDim Preserve Tableau(I)
      Tableau(I) = Tablo(N)
      Li = N
    End If
  Next
 [COLOR=SeaGreen] 'ajout feuille temporaire pour les lignes gardées[/COLOR]
  ActiveSheet.Copy after:=ActiveSheet
  ActiveSheet.Name = "TMP"
  ActiveSheet.Range("A3:O" & Derli).ClearContents
  Sheets("Base_sinistres").Select
  'ajout des lignes de la dernière année
  L = 2
  For N = 3 To Derli
    For X = 1 To I
      If Cells(N, "K") = Tableau(X) Then
        L = L + 1
        Range("A" & N & ":O" & N).Copy Sheets("TMP").Range("A" & L)
        Exit For
      End If
    Next
  Next
  Sheets("Base").Range("A" & Li & ":O" & Derli).Copy Sheets("TMP").Range("A" & L + 1)
 [COLOR=SeaGreen] 'suppression feuilles temporaires[/COLOR]
  ActiveSheet.Delete
  Sheets("Base").Delete
  Sheets("TMP").Select
  ActiveSheet.Name = "Base_sinistres"
End Sub