Try
Sub test()
Dim a, b, i As Long, ii As Long, iii As Long, n As Long, x, y
a = Sheets("raw").Cells(1).CurrentRegion.Value
ReDim b(1 To 1000, 1 To UBound(a, 2))
For i = 1 To UBound(a, 1)
ReDim x(0), y(0)
If a(i, 2) <> "" Then x = Split(a(i, 2), ";")
If a(i, 3) <> "" Then y = Split(a(i, 3), ";")
For ii = 0 To Application.Max(UBound(x), UBound(y))
n = n + 1
For iii = 1 To UBound(a, 2)
If iii = 2 Then
If UBound(x) >= ii Then b(n, iii) = Trim$(x(ii))
ElseIf iii = 3 Then
If UBound(y) >= ii Then b(n, iii) = Trim$(y(ii))
Else
b(n, iii) = a(i, iii)
End If
Next
Next
Next
Sheets.Add.Cells(1).Resize(n, 7) = b
End Sub
Bookmarks