Sub CopyCols()
Application.ScreenUpdating = False
Dim LastRow As Long, x As Long
LastRow = Range("H" & Rows.Count).End(xlUp).Row
For x = 8 To 10
Cells(1, x).Resize(LastRow).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
Next x
Range("A1").Delete
Application.ScreenUpdating = True
End Sub
Try:
VBA Code:Sub CopyCols() Application.ScreenUpdating = False Dim LastRow As Long, x As Long LastRow = Range("H" & Rows.Count).End(xlUp).Row For x = 8 To 10 Cells(1, x).Resize(LastRow).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1) Next x Range("A1").Delete Application.ScreenUpdating = True End Sub
Column1 | Column2 | Column3 | Column1 | |
A | E | I | A | |
B | F | J | B | |
C | G | K | C | |
D | H | L | D | |
E | ||||
F | ||||
G | ||||
H | ||||
I | ||||
J | ||||
K | ||||
L | ||||
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
T2C = Table.ToColumns(Source),
C2T = Table.FromList(T2C, Splitter.SplitByNothing(), null, null, ExtraValues.Error),
Expand = Table.ExpandListColumn(C2T, "Column1")
in
Expand
Thank you very much for your help!with Power Query (Get&Transform) built in XL2016
Column1 Column2 Column3 Column1 A E I A B F J B C G K C D H L D E F G H I J K L
Power Query:let Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content], T2C = Table.ToColumns(Source), C2T = Table.FromList(T2C, Splitter.SplitByNothing(), null, null, ExtraValues.Error), Expand = Table.ExpandListColumn(C2T, "Column1") in Expand
if you don't care: by rows
Cell Formulas Range Formula A1:A12 A1 =IFERROR(INDEX($B$1:$D$4,INT((ROWS($B$1:$B1)-1)/COLUMNS($B$1:$D$4))+1,MOD(ROWS($B$1:$B1)-1,COLUMNS($B$1:$D$4))+1),"")
maybe someone else will give you solution by columns