Private Sub Worksheet_Change(ByVal Target As Range)
Dim source As Range, dest As Range, tablo, d As Object, ncol&, resu(), i&, x$, n&, lig&, col&
Set source = [C3].CurrentRegion.Resize(, 3) 'à adapter
Set dest = [H4] '1ère cellule de destination, à adapter
tablo = source 'matrice, plus rapide
Application.ScreenUpdating = False
Application.EnableEvents = False
dest.Resize(Rows.Count - dest.Row + 1, Columns.Count - dest.Column + 1).ClearContents 'RAZ
'---dimensions du tableau des résultats---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
d(tablo(i, 3)) = d(tablo(i, 3)) + 1 'comptage
Next
If d.Count = 0 Then GoTo 1
ncol = 2 + 2 * Application.Max(d.items)
ReDim resu(1 To d.Count, 1 To ncol)
'---remplissage du tableau des résultats---
d.RemoveAll
For i = 2 To UBound(tablo)
x = tablo(i, 3)
If Not d.exists(x) Then
n = n + 1
resu(n, 1) = x
d(x) = n 'mémorise le numéro de ligne
End If
lig = d(x)
resu(lig, ncol) = resu(lig, ncol) + 2 'mémorise le numéro de colonne
col = resu(lig, ncol)
resu(lig, col) = tablo(i, 1)
resu(lig, col + 1) = tablo(i, 2)
Next
'---restitution---
If ncol + dest.Column > Columns.Count Then ncol = Columns.Count - dest.Column 'sécurité
dest.Resize(n, ncol - 1) = resu
1 Application.EnableEvents = True
End Sub