Sub NouveauTableau()
Dim lig&, i&, txt1$, txt2$, s, ub%, j%
Application.ScreenUpdating = False
lig = 2 '1ère ligne du nouveau tableau
Range(Cells(lig, "G"), Cells(Rows.Count, "J")).ClearContents
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
txt1 = Application.Trim(Cells(i, "D")) 'SUPPRESPACE par sécurité
txt2 = Replace(Application.Trim(Cells(i, "E")), ", ", ",") 'sécurité
txt2 = txt1 & IIf(txt1 = "" Or txt2 = "", "", ",") & txt2
s = Split(txt2, ",")
ub = UBound(s)
For j = 0 To Application.Max(ub, 0)
Cells(lig, "G").Resize(, 3) = Cells(i, "A").Resize(, 3).Value
If ub >= 0 Then Cells(lig, "J") = s(j)
lig = lig + 1
Next
Next
End Sub