Insert new rows as per the delimits

Heres one way

Sub abc()
 For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    sDelimiter = Cells(r, 1)
    If InStr(1, sDelimiter, "|", vbTextCompare) Then
        a = Split(sDelimiter, "|")
         For ii = 1 To UBound(a)
            Cells(r, 1).Offset(1).EntireRow.Insert shift:=xlDown
         Next
         Cells(r, 1).Resize(UBound(a) + 1) = Application.Transpose(a)
    End If
 Next
End Sub

Give this a try

Sub abc()
 Application.ScreenUpdating = False
 For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    sDelimiter = Cells(r, 1)
    If InStr(1, sDelimiter, "|", vbTextCompare) Then
        a = Split(sDelimiter, "|")
         arr = Cells(r, "G").Resize(, 5)
         For ii = 1 To UBound(a)

            With Range("A" & r).Offset(1)
                .EntireRow.Insert shift:=xlDown, copyorigin:=xlAbove
                .Offset(-1, 6).Resize(, 5) = arr
            End With

         Next
         Cells(r, 1).Resize(UBound(a) + 1) = Application.Transpose(a)
    End If
 Next
 Columns("K:K").WrapText = True
 Application.ScreenUpdating = True
End Sub