Sub Analyse()
Dim tablo, ub%, d As Object, i&, j%, p%, restit$(), col%
tablo = Feuil1.UsedRange 'Feuil1 => CodeName à adapter
ub = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
With Feuil2 'CodeName de la feuille de restitution, à adapter
'---initialisation---
.Cells.Delete
.[1:1].Font.Bold = True 'gras
.[1:1].Font.ColorIndex = 5 'bleu
'---titres des colonnes, sans doublon---
For i = 1 To UBound(tablo)
For j = 1 To ub
tablo(i, j) = Trim(tablo(i, j)) 'des titres sont précédés d'espaces...
tablo(i, j) = Replace(tablo(i, j), "::", ":") 'pour PUN...
p = InStrRev(tablo(i, j), ":")
If p Then d(Left(tablo(i, j), p)) = Left(tablo(i, j), p)
Next
Next
.[A1].Resize(, d.Count) = d.Items
.[1:1].Sort .[A1], Orientation:=xlLeftToRight 'tri
'---analyse ligne par ligne---
ReDim restit(1 To UBound(tablo), 1 To d.Count)
For i = 1 To UBound(tablo)
For j = 1 To ub
p = InStrRev(tablo(i, j), ":")
If p Then
col = Application.Match(Left(tablo(i, j), p), .[1:1], 0)
restit(i, col) = restit(i, col) & IIf(restit(i, col) = "", "", vbLf) & Mid(tablo(i, j), p + 1)
End If
Next
Next
'---restitution---
.[A2].Resize(UBound(tablo), d.Count) = restit
.UsedRange.Columns.AutoFit 'ajustement de la largeur des colonnes
.Activate
End With
End Sub