Copy section to end of previous section

[rowbro]

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

 

[sijpie]

<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>