Loop To Move all Columns into One Column - vba

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

Answer 1

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.

Answer 2

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