Copy section to end of previous section

rowbro

New Member
Joined
Dec 16, 2010
Messages
43
Hi All,

I have a massive table of data that I am trying to rearrange in the most time-efficient manner possible. From column D to II I have data from row 2 to 375, with each three columns (i.e. D, E and F) being related. I would like to rearange all this data into three columns (A to C) by copying each set of data (for example D2:F375) to the bottom of the set of data in columns A to C. Is there some clever VBA that could do this?

Thanks in advance
 

Some videos you may like

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,734
<font face=Calibri>Option Explicit<br><SPAN style="color:#007F00">' always have option exlicit as your first line in any module</SPAN><br><br><br><SPAN style="color:#00007F">Sub</SPAN> moveColumns()<br>    <SPAN style="color:#00007F">Dim</SPAN> rOut <SPAN style="color:#00007F">As</SPAN> Range, rIn <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> wsOut <SPAN style="color:#00007F">As</SPAN> Worksheet, wsIn <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> lR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, lC <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#007F00">' we'll use some shortcuts to make things easy tofollow</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsIn = ActiveSheet<br>    <SPAN style="color:#007F00">' we'll put the output on a new sheet, so we don't disturb the original</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsOut = Sheets.Add(after:=wsIn)<br>    <SPAN style="color:#00007F">With</SPAN> wsOut<br>        .Name = "CombinedCols"<br>        <SPAN style="color:#00007F">Set</SPAN> rOut = .Range("A1")<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#007F00">' get the number of rows in the columns to be transferred</SPAN><br>    lR = wsIn.Range("A1").CurrentRegion.Rows.Count<br>    <SPAN style="color:#007F00">'now for every three columns</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> lC = 1 <SPAN style="color:#00007F">To</SPAN> wsIn.Range("A1").CurrentRegion.Columns.Count <SPAN style="color:#00007F">Step</SPAN> 3<br>        <SPAN style="color:#007F00">'set the range to be copied</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> rIn = wsIn.Cells(1, lC).Resize(lR, 3)<br>        <SPAN style="color:#007F00">' copy the values from the input columns to the output</SPAN><br>        rOut.Resize(rIn.Rows.Count, 3).Value = rIn.Value<br>        <SPAN style="color:#007F00">' move the output point to the end of the curent output</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> rOut = rOut.End(xlDown).Offset(1, 0)<br>    <SPAN style="color:#00007F">Next</SPAN> lC<br>    <br>    <SPAN style="color:#007F00">' clean up</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rOut = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rIn = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsIn = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsOut = <SPAN style="color:#00007F">Nothing</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 

Watch MrExcel Video

Forum statistics

Threads
1,122,519
Messages
5,596,635
Members
414,083
Latest member
Mrsash

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top