Private Sub Worksheet_Activate()
Dim tablo, resu(), d As Object, i&, x As Variant, mois As Date, n&
tablo = Sheets("Tableau").ListObjects(1).Range.Resize(, 3) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 3)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = tablo(i, 1)
If IsDate(x) Then
mois = DateSerial(Year(x), Month(x), 1)
If Not d.exists(mois) Then n = n + 1: d(mois) = n: resu(n, 1) = mois
If IsNumeric(tablo(i, 2)) Then resu(n, 2) = resu(n, 2) + CDbl(tablo(i, 2))
If IsNumeric(tablo(i, 3)) Then resu(n, 3) = resu(n, 3) + CDbl(tablo(i, 3))
End If
Next
'---restitution---
With ListObjects(1).Range.Rows(2)
If n Then
.Cells(1).Resize(n, 3) = resu
.Cells(1).Resize(n, 3).Sort .Cells(1), xlAscending, Header:=xlYes 'tri sur les mois
.Cells(1, 4).Resize(n) = "=RC[-1]-RC[-2]"
.Cells(1, 5).Resize(n) = "=SUM(R" & .Cells(1).Row & "C[-1]:RC[-1])"
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1).EntireRow.Delete 'RAZ en dessous
End With
Columns.AutoFit 'ajustement largeurs
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub