Loop To Move all Columns into One Column

Question

I'm taking data that is listed across multiple columns and putting it into a single column (A). If there is data in column B, it grabs that data, sticks it at the end of the data in column A, then goes back and deletes the now empty column B, which moves all the other columns over one so now there is data in column B again, up until the point there are no more columns of data except for column A. The way I'm doing this currently is by listing multiple blocks of the same code below which is not efficient obviously and sooner or later the code will break. Any advice is appreciated!!

Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -1).Range("A1").Select

give it a try and come back with your looping code. Then we can help. — Sorceri, Feb 05 '15 at 20:51
Please [stop using .select](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) — Chrismas007, Feb 05 '15 at 20:56
Thank you for the references to the previous post @Chrismas007 which discuss using ranges and the avoidance of select. This is very useful. — Joseph, Feb 05 '15 at 22:36

score 2 · Answer 1 · answered Feb 05 '15 at 22:23

I like Christmas007's answer. I wanted to share this solution too:

Sub MoveIt()
Dim mysht As Worksheet
Set mysht = ActiveSheet
Set myrng = mysht.UsedRange


nextrow = mysht.Cells(mysht.Rows.Count, 1).End(xlUp).Row

For i = 2 To myrng.Columns.Count

lastColrow = myrng.Cells(mysht.Rows.Count, i).End(xlUp).Row
If lastColrow <> 1 Or myrng.Cells(1, i) <> "" Then
    For j = 1 To lastColrow
        nextrow = nextrow + 1
        mysht.Cells(nextrow, 1) = myrng.Cells(j, i)

    Next j
End If
Next i

Range(myrng.Columns(2), myrng.Columns(myrng.Columns.Count)).Clear


End Sub

I like it because it doesn't use the copy, paste, and delete functions. In my experience these functions start to cause the macro to drag if you are dealing with big workbooks and they also require that the sheet is activated.

score 1 · Accepted Answer · answered Feb 05 '15 at 21:00

1

There is a pretty simple way to do this:

Sub MoveIt()

Dim LastRow As Long
Dim ws1 as Worksheet

Set ws1 = Sheets("Name of Sheet")

Do While (ws1.Range("B1").Value <> "")
    LastRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1
    ws1.Range("B1:B" & ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row).Copy
    ws1.Range("A" & LastRow).PasteSpecial
    ws1.Range("B1").EntireColumn.Delete xlToLeft
Loop

End Sub

answered Feb 05 '15 at 21:00

Chrismas007

6,085
4
24
47

1

This worked great @Chrismas007. Thank you for your input. I know the smart folks like you in various forums get tired of guys like me asking questions where it doesn't appear we've attempted to do our own research, and I would too, but in this case I didn't know where to even start. Appreciate your input. – Joseph Feb 05 '15 at 22:30

Loop To Move all Columns into One Column

2 Answers2