Sub essai()
ligne = 2
For Each c In Range("A2:A" & [A65000].End(xlUp).Row)
Set f2 = Sheets(2)
a = Split(c.Offset(0, 4), ",")
If UBound(a) > -1 Then
For i = LBound(a) To UBound(a)
f2.Cells(ligne, 1) = c
f2.Cells(ligne, 2) = c.Offset(0, 1)
f2.Cells(ligne, 3) = c.Offset(0, 2)
f2.Cells(ligne, 4) = c.Offset(0, 3) & Trim(a(i))
ligne = ligne + 1
Next i
Else
f2.Cells(ligne, 1) = c
f2.Cells(ligne, 2) = c.Offset(0, 1)
f2.Cells(ligne, 3) = c.Offset(0, 2)
f2.Cells(ligne, 4) = c.Offset(0, 3)
ligne = ligne + 1
End If
Next c
End Sub