Transpose Data In Columns

[parscon]

Hi , I have VBA that do the Data on Column A that they Separate by | and Transport to next column with the same data in B Column . and it is working fine now just need also repeat till F column. Please check the below image you will understand better .

27966



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

[snb]

Sub M_snb()
sn=sheet1.cells(4,1).currentregion

with createobject("scripting.dictionary")
for j=2 to ubound(sn)
st=split(sn(j,1),"|")
for jj=0 to ubound(jj)
.item(.count)=array(st(jj),sn(j,2),sn(j,3),sn(j,4))
next

sheet1.cells(1,10).resize(.count)=application.index(.items,0,0)
next
end with
End Sub

[p45cal]

Dead easy in Power Query:
let
Source = Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
SplitColumnbyDelimiter = Table.ExpandListColumn(Table.TransformColumns(Source, {{"Hdr1", Splitter.SplitTextByDelimiter("|", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Hdr1")
in
SplitColumnbyDelimiter
27967

…but in the same vein as before:
Sub blah2()
myWidth = 4 'adjust
lr = Cells(Rows.Count, 1).End(xlUp).Row
SceVals = Range(Cells(1), Cells(lr, myWidth)).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 myWidth)
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)
For k = 2 To myWidth
myresults(DestRow, k) = SceVals(i, k)
Next k
Next j
Next i
Sheets("Sheet2").Cells(1).Resize(UBound(myresults), myWidth).Value = myresults
End Sub
but note that your picture shows data to column D but your narrative suggests to column F; adjust the line myWidth = 4 to accommodate.

[parscon]

Thanks for your help by i need result in sheet 2 i attached the Excel File . could you please check it .

[snb]

Where did you get the first Code from ?

[p45cal]

Button on Sheet1 at cell F1 uses the macro blah2 to populate Sheet2
Right click on the table in Sheet3 and choose Refresh to update the query which uses the data from Sheet1

[parscon]

Really Good Job Man , You saved me !

[mancubus]

...

[mancubus]

Where did you get the first Code from ?

http://www.vbaexpress.com/forum/showthread.php?63531-Transpose-Data-In-Columns

OP's another thread.