Creating multiple rows from single row of data

Hi RaydenUK,
try this

Sub ertert()
Dim x, y(), sp, i&, j&, k&
x = Sheets("Before").Range("A1").CurrentRegion.Value
ReDim y(1 To 4, 1 To UBound(x))
For i = 1 To UBound(x)
    sp = Split(x(i, 4), "_")
    For j = LBound(sp) To UBound(sp)
        k = k + 1: If k > UBound(y, 2) Then ReDim Preserve y(1 To 4, 1 To UBound(y, 2) * 1.5)
        y(1, k) = x(i, 1)
        y(2, k) = x(i, 2)
        y(3, k) = x(i, 3)
        y(4, k) = sp(j)
    Next j
Next i
With Sheets("After")
    .UsedRange.ClearContents
    .Range("A1:D1").Resize(k).Value = Application.Transpose(y)
    .Activate
End With
End Sub