将数据从B列剪切/粘贴到A列中的第一个空单元格

Question

I have just one worksheet that has 6 columns and 10 rows. So the Range of my table is A1:F10 which has 60 cells.

I simply need to cut the data from column B and paste it into the first empty cell in column A. Then, I need it to do the same with columns C - F. Eventually I want to have only one column (Column A) that is 60 rows deep.

Sub Move_Columns()
    Range("B1:B10").Copy Destination:=Range("A11")
    Range("C1:C10").Copy Desitnation:=Range("21")
    ' this would continue until columns B-F were copied in column A
End Sub

The problem is that this code only copies the data over. I need it removed once it has been copied. I'm also sure there is a much more efficient way to write the code so that I don't have to keep repeating the ranges.

I wish I knew how to write the code so that Excel will automatically cut and paste the data from each column into the first empty row in column A.

Would the For Each Statement be a good idea to add in there?

Answer 1

I make this code, and put some comments to help you to understand.

Sub MoveAllInFirstColumn()
    Dim i As Integer
    Dim lastCol As Integer
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column 'finds the last column
    For i = 2 To lastCol ' foreach columns except first
        Dim lastRow As Integer
        lastRow = Cells(Rows.Count, "A").End(xlUp).Row 'get the lastrow of current column
        Range(Cells(1, i), Cells(Cells(Rows.Count, i).End(xlUp).Row, i)).Cut Cells(lastRow + 1, 1) 'cut and paste the current column to the first column
    Next i
End Sub

Answer 2

To continue with what you have:

Sub Move_Columns()
  Range("B1:B10").Copy Destination:=Range("A11")
  Range("B1:B10").ClearContents
  Range("C1:C10").Copy Desitnation:=Range("A21")
  Range("C1:C10").ClearContents
  ' this would continue until columns B-F were copied in column A
End Sub

An alternative with some looping

Sub Move_Columns()
Dim StartCol as Integer
Dim EndCol as Integer
Dim StartRow as Integer
Dim EndRow as Integer
Dim CurRow as Integer
Dim i as Integer
Dim DestCol as integer

DestCol = 1
StartCol = 2
EndCol = 6
StartRow = 1
EndRow = 10

CurRow = StartRow
for I = StartCol to EndCol
  'Range(cells(i, StartRow),cells(i, EndRow).Copy Destination:=Range(DestCol,CurRow)
  'Range(cells(i, StartRow),cells(i, EndRow).ClearContents
  Range(cells(StartRow, i), cells(EndRow, 1)).Copy Destination:=Range(DestCol, CurRow)
  Range(cells(StartRow, i),cells(EndRow,i)).ClearContents
  CurRow = CurRow + EndRow
Next
end Sub