Creating multiple rows from single row of data

I have a list of data that has information from column D that is put together with "_". I need to separate this data and create new rows for each row of data with all the same information in columns A:C but with each individual character in column D.

I have attached a spreadsheet that will show the before and after for what the data needs to look like.
Creating new rows with methods question.xlsx

Help is greatly appreciated!

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

Sub Rayden()
Dim ws1 As Worksheet:   Set ws1 = Sheets("Before") 'source sheet
Dim ws2 As Worksheet:   Set ws2 = Sheets("After") 'destination sheet
Dim c As Range
Dim v As Variant
Dim i As Integer

Application.ScreenUpdating = False

For Each c In ws1.Range("D2:D" & ws1.Range("D" & Rows.Count).End(xlUp).Row)
    If Not InStr(1, c, "_") = 0 Then
        v = Split(c, "_")
        For i = LBound(v) To UBound(v)
            ws1.Range("A" & c.Row, "C" & c.Row).Copy ws2.Range("A" & Rows.Count).End(3)(2)
            ws2.Range("D" & Rows.Count).End(3)(2) = v(i)
        Next i
    Else
        c.Offset(, -3).Resize(1, 4).Copy ws2.Range("A" & Rows.Count).End(3)(2)
    End If
Next c

Application.ScreenUpdating = True

End Sub

Yet another approach:

Sub RaydenUK()

LastRow = Cells(Rows.Count, "D").End(xlUp).Row

For i = LastRow To 2 Step -1
Methods = Cells(i, 4).Value
If InStr(1, Methods, "_") Then
    For j = UBound(Split(Methods, "_")) To 0 Step -1
    Rows(i + 1).EntireRow.Insert
    Rows(i).Copy Rows(i + 1)
    Cells(i + 1, 4) = Split(Methods, "_")(j)
    Next
Rows(i).EntireRow.Delete
End If
Next

End Sub

Ha! Thanks everyone! I actually tried all of these and they work perfect. If I may ask though, what would the code look like to do the reverse? I ask because I have to alter the methods once they are in their own columns, but then I have to put them back into their original format like they started. I really appreciate the help!

Reverse:

Sub RaydenUK_2()

i = 2
Do
    Acc = Cells(i, 1).Value
    If Cells(i + 1, 1).Value <> Acc Then
        Acc = Cells(i + 1, 1).Value
        i = i + 1
    Else
        Cells(i, 4).Value = Cells(i, 4).Value & "_" & Cells(i + 1, 4).Value
        Rows(i + 1).EntireRow.Delete
    End If
Loop While Cells(i, 1).Value <> ""

End Sub

Thank you walruseggman that works perfect! I am very grateful for everyone's help.