Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G1]) Is Nothing Then Exit Sub
Dim dat, dest As Range, d As Object, dd As Object, tablo, i&, x$, titre, ncol%, j%, a
dat = [G1]
Set dest = [G4] '1ère cellule de destination
'---tableau source---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = [Tableau2] 'tableau structuré
For i = 1 To UBound(tablo)
d(tablo(i, 2)) = ""
x = tablo(i, 2) & tablo(i, 4) & tablo(i, 3) & tablo(i, 1)
If Not dd.exists(x) Then dd(x) = tablo(i, 5)
Next i
If d.Count = 0 Then GoTo 1
'---tableau des titres---
titre = [G2:AE3] 'à adapter
ncol = UBound(titre, 2)
For j = 2 To ncol
If titre(1, j) = "" Then titre(1, j) = titre(1, j - 1) 'remplit les cellules vides
Next j
'---tableau des résultats---
tablo = dest.Resize(d.Count, ncol)
a = d.keys
For i = 0 To UBound(a)
tablo(i + 1, 1) = a(i)
Next i
For i = 1 To UBound(tablo)
For j = 2 To ncol
tablo(i, j) = dd(tablo(i, 1) & titre(2, j) & titre(1, j) & dat)
Next j, i
'---restitution---
With dest.Resize(d.Count, ncol)
.Value = tablo
.Borders.Weight = xlThin
.Columns(1).Interior.ColorIndex = 20 'bleu
End With
'---RAZ en dessous---
1 dest.Offset(d.Count).Resize(Rows.Count - d.Count - dest.Row + 1, ncol).Delete xlUp
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub