Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G3]) Is Nothing Then Exit Sub
Dim an%, tablo, liste(), d As Object, i&, x$, n&, lig&, col As Byte
an = [G3]
If an > 0 Then
tablo = [A5].CurrentRegion.Resize(, 4)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(tablo)
If Year(tablo(i, 1)) = an Then
x = tablo(i, 2)
If Not d.exists(x) Then
n = n + 1
d(x) = n
ReDim Preserve liste(1 To 13, 1 To n)
liste(1, n) = x
End If
lig = d(x): col = 1 + Month(tablo(i, 1))
liste(col, lig) = liste(col, lig) + tablo(i, 4)
End If
Next
End If
'---restitution---
With [F6] '1ère cellule de destination, à adapter
If n Then
.Resize(n, 13) = Application.Transpose(liste) 'Transpose est limitée à 65536 lignes
.Resize(n, 13).Interior.ColorIndex = 36 'jaune clair
.Resize(n, 13).Borders.Weight = xlHairline 'bordures
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1, 13).Delete xlUp 'RAZ sous le tableau
End With
End Sub