Transpose Data In Columns

[parscon]

Hi. I need again your help I have Data on Column A that they Separate by | and i need Transport to next column with the same data in B Column . If you see the below image you will understand correctly .
I have about 350000 items and Really i need your help .

Request.jpg

Thanks for your help and support .

[p45cal]

Click the button in the attached.
The code:

Sub blah()
lr = Cells(Rows.Count, 1).End(xlUp).Row
SceVals = Range(Cells(1), Cells(lr, 2)).Value
For i = 1 To lr
  ExtraRowsNeeded = ExtraRowsNeeded + (Len(SceVals(i, 1)) - Len(Replace(SceVals(i, 1), "|", "", 1, , vbTextCompare)))
Next i
ReDim myresults(1 To lr + ExtraRowsNeeded, 1 To 2)
DestRow = 0
For i = 1 To lr
  x = Split(SceVals(i, 1), "|")
  For j = 0 To UBound(x)
    DestRow = DestRow + 1
    myresults(DestRow, 1) = x(j)
    myresults(DestRow, 2) = SceVals(i, 2)
  Next j
Next i
Sheets("Sheet2").Cells(1).Resize(UBound(myresults), 2).Value = myresults
End Sub

[parscon]

Really Appreciate for your help . you saved me . Thank you

[snb]

Alternatively:

Sub M_snb()
    sp = Sheet1.Cells(1).CurrentRegion
    sn = Split(Join(Application.Transpose(Sheet1.UsedRange.Columns(1)), "|"), "|")
    ReDim sq(UBound(sn), 1)
    
    For j = 0 To UBound(sn)
      sq(j, 0) = sn(j)
      For jj = 1 To UBound(sp)
        If InStr(sp(jj, 1), sn(j)) Then Exit For
      Next
      sq(j, 1) = sp(jj, 2)
    Next
    
    sheet2.Cells(1).Resize(UBound(sq) + 1, 2) = sq
End Sub