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 .

22789

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