voici le code en question:
Sub Extrait2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set F = Sheets("Feuil1")
Set d = CreateObject("scripting.dictionary")
Tbl = F.Range("b2:b" & F.[b65000].End(xlUp).Row).Value
For i = 1 To UBound(Tbl)
temp = Format(Tbl(i, 1), "mmmm yyyy")
d(temp) = ""
Next i
[Z2].Formula = "=and(MONTH(b2)=$aa$1,year(b2)=$ab$1)"
'[ad2].Resize(d.Count) = Application.Transpose(d.keys)
For Each c In d.keys
On Error Resume Next: Sheets(c).Delete: On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' cr?ation
If c <> vbNullString Then
ActiveSheet.Name = c
'-- extraction
F.[aa1] = Month("01/" & c): F.[ab1] = Right(c, 4)
F.[A1:g10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=F.[z1:z2], CopyToRange:=[A1]
End If
Next c
End Sub