Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, resu(), d As Object, i&, x$, n&, nn&
tablo = ListObjects(1).Range.Resize(, 2) '1er tableau structuré
ReDim resu(1 To UBound(tablo), 1 To 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = tablo(i, 1)
If x <> "" Then
If Not d.exists(x) Then
n = n + 1
d(x) = n 'mémorise la ligne
resu(n, 1) = x
resu(n, 2) = tablo(i, 2)
Else
nn = d(x)
resu(nn, 2) = resu(nn, 2) & ";" & tablo(i, 2) 'concaténation
End If
End If
Next
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With ListObjects(2).Range '2ème tableau structuré
If .Rows.Count > 2 Then .Rows(3).Resize(.Rows.Count - 2).Delete xlUp
If n Then .Rows(2).Resize(n) = resu Else .Rows(2).ClearContents
End With
Application.EnableEvents = True 'dréactive les évènements
End Sub