Private Sub Worksheet_Activate()
Dim P As Range, critere As Range, datemax As Date, datemin As Date, col%, x$, dat As Long
Set P = Sheets("BdD").[A1].CurrentRegion 'adapter le nom de la feuille
Set critere = P(2, P.Columns.Count + 2)
datemin = Application.Min(P.Columns(7))
datemax = Application.EoMonth(Application.Max(P.Columns(7)), 0)
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
Columns(2).Resize(, Columns.Count - 1).Delete 'RAZ
For col = 1 To 256
x = Application.Proper(Format(Application.EDate(datemin, col - 1), "mmmm yyyy")) 'en-têtes
dat = CDate("1/" & x)
If dat > datemax Then Exit For
Cells(1, col) = x 'en-tête
critere = "=AND(G2>=" & dat & ",G2<EDATE(" & dat & ", 1))"
P.AdvancedFilter xlFilterInPlace, critere(0).Resize(2) 'filtre avancé
P.Columns(1).SpecialCells(xlCellTypeVisible).Copy
Cells(2, col).PasteSpecial xlPasteValues 'collage spécial valeurs
Next
Rows(2).Delete 'supprime les titres copiés
Columns.AutoFit 'ajustement largeurs
critere = ""
P.Parent.ShowAllData 'affiche tout
Application.Goto [A1], True 'cadrage
End Sub