Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:B]) Is Nothing Then Exit Sub
Dim dest As Range, t, d1 As Object, d2 As Object, i&, ub&, a, j%, s, ubs&
Set dest = [E2] 'cellule de destination, à adapter
Application.ScreenUpdating = False
dest.Resize(Rows.Count - dest.Row + 1, Columns.Count - dest.Column + 1) = "" 'RAZ
'---liste des agences---
t = [A1].CurrentRegion.Resize(, 2)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
d1(t(i, 2)) = d1(t(i, 2)) + 1 'comptage
d2(t(i, 2)) = d2(t(i, 2)) & Chr(1) & t(i, 1) 'concaténation
Next
If d1.Count = 0 Then Exit Sub
'---tableau des résultats---
ReDim t(1 To Application.Max(d1.items), 1 To d1.Count)
ub = UBound(t)
a = d2.items
For j = 1 To d1.Count
s = Split(a(j - 1), Chr(1))
ubs = UBound(s)
For i = 1 To ub
If i <= ubs Then t(i, j) = s(i)
Next i, j
'---restitution---
dest.Resize(, d1.Count) = d1.keys 'agences
dest(2).Resize(ub, d1.Count) = t 'employés
End Sub