Formules extraire Date

Sub Synthèse()
Dim T, dico, TT, Plage As Range, i As Long
Set dico = CreateObject("Scripting.Dictionary")
With Worksheets("Releve")
Set Plage = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row)
Plage.Sort Key1:=Range("A2"), Order1:=xlAscending
End With
T = Plage
For i = LBound(T, 1) To UBound(T, 1) - 1
    T(i, 1) = CDbl(T(i, 1))
    If Month(T(i, 1)) <> Month(T(i + 1, 1)) Then dico(T(i, 1)) = T(i, 2)
Next

dico(T(UBound(T, 1), 1)) = T(UBound(T, 1), 2)
TT = Application.Transpose(Array(dico.keys, dico.Items))

With Worksheets("Synthese")
.Range("A2").Resize(UBound(TT, 1), UBound(TT, 2)) = TT
.Columns(1).NumberFormat = "m/d/yyyy"
End With
End Sub

dico(T(UBound(T, 1), 1)) = T(UBound(T, 1), 2)

T(UBound(T, 1), 1) = CDbl(T(UBound(T, 1), 1))

=SIERREUR(INDEX(Releve!A:A;PETITE.VALEUR(SI(ESTNUM(Releve!$A$1:$A$1000);SI(LIGNE(Releve!$A$1:$A$1000)=EQUIV(DATE(ANNEE(Releve!$A$1:$A$1000);MOIS(Releve!$A$1:$A$1000)+1;0);Releve!$A$1:$A$1000);LIGNE(Releve!$A$1:$A$1000)));LIGNES(A$2:A2)));"")

Private Sub Workbook_Open()
   Synthèse
End Sub

=SIERREUR(RECHERCHE(A2;Dates:Montants);"")

Private Sub Worksheet_Activate()
Dim t, i&, x$, anmois$, n&
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
For i = 1 To UBound(t)
  If IsDate(t(i, 1)) Then
    x = Year(t(i, 1)) & Month(t(i, 1))
    If x <> anmois Then anmois = x:: n = n + 1
    t(n, 1) = t(i, 1): t(n, 2) = t(i, 2)
  End If
Next
If n Then [A2].Resize(n, 2) = t
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