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