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?
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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.