Sub creerResult()
Set f = Sheets("test")
Set r = Sheets("result")
i = f.[A65000].End(xlUp).Row
k = 2
For Each xcel In f.Range("A2:A" & i)
a = f.Cells(xcel.Row, 1)
b = f.Cells(xcel.Row, 2)
c = f.Cells(xcel.Row, 3)
p = Split(f.Cells(xcel.Row, 4), ";")
m = UBound(p)
q = Split(f.Cells(xcel.Row, 5), ";")
n = UBound(q)
If m <> n Then
MsgBox ("ERREUR" & vbCrLf & "Nombre de champs différents")
Exit Sub
Else
For j = 0 To m
r.Cells(k, 1) = a
r.Cells(k, 2) = b
r.Cells(k, 3) = c
r.Cells(k, 4) = p(j)
r.Cells(k, 5) = q(j)
k = k + 1
Next j
End If
Next xcel
End Sub