Sub Traitement()
Dim source As Range, dest As Range, t, d1 As Object, d2 As Object
Dim d3 As Object, i&, ncol%, rest(), a, j%, an%, x$
Set source = [G8].CurrentRegion.Resize(, 4) 'à adapter
Set dest = [L8] 'à adapter
t = source
Set d1 = CreateObject("Scripting.Dictionary") 'année
Set d2 = CreateObject("Scripting.Dictionary") 'nom
Set d3 = CreateObject("Scripting.Dictionary") 'année+nom
d2.CompareMode = vbTextCompare 'la casse est ignorée
d3.CompareMode = vbTextCompare
'---dimensions du tableau rest---
For i = 1 To UBound(t) 'For i = 2 si ligne de titres
d1(t(i, 1)) = ""
d2(t(i, 2)) = ""
d3(t(i, 1) & t(i, 2)) = i 'repérage de la ligne
Next
ncol = d2.Count + 1
ReDim rest(1 To 2 * d1.Count + 1, 1 To ncol)
'---remplissage des 1ère et 2ème colonnes du tableau rest---
a = d1.keys
For i = 2 To UBound(rest) Step 2
rest(i, 1) = "Somme": rest(i, 2) = a(i / 2 - 1)
rest(i + 1, 1) = "Nbre": rest(i + 1, 2) = rest(i, 2)
Next
'---remplissage de la 1ère ligne du tableau rest---
a = d2.keys
For j = 2 To ncol
rest(1, j) = a(j - 2)
Next
'---reste du remplissage---
a = d3.items
For i = 2 To UBound(rest) Step 2
an = rest(i, 2)
For j = 3 To ncol
x = an & rest(1, j)
rest(i, j) = t(d3(x), 3)
rest(i + 1, j) = t(d3(x), 4)
Next j, i
'---restitution---
Application.ScreenUpdating = True
dest.CurrentRegion.ClearContents 'RAZ
dest.Resize(UBound(rest), ncol) = rest
End Sub