Private Sub Worksheet_Activate()
Dim t, d As Object, i&, x$, n&, j&
With Feuil1 'CodeName de la 1ère feuille
If Application.Count(.[A:A]) = 0 Then GoTo 1 'si aucune date
t = .[A1].Resize(Application.Match(9 ^ 9, .[A:A]), 2) 'matrice, plus rapide
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
If IsDate(t(i, 1)) Then
x = Year(t(i, 1)) & Month(t(i, 1))
If Not d.exists(x) Then n = n + 1: d(x) = n: t(n, 1) = t(i, 1): t(n, 2) = t(i, 2)
j = d(x)
If t(i, 1) > t(j, 1) Then t(j, 1) = t(i, 1): t(j, 2) = t(i, 2)
End If
Next
If n = 0 Then GoTo 1 'sécurité
Application.ScreenUpdating = False
With [A2].Resize(n, 2)
.Value = t 'restitution
.Sort .Columns(1), xlAscending, Header:=xlNo 'tri sur les dates
End With
1 Range("A" & n + 2 & ":B" & Rows.Count) = ""
[A1].Resize(n + 1).Name = "X" 'plage nommée
[B1].Resize(n + 1).Name = "Y" 'plage nommée
End Sub