VBA MACRO TO CUT AND PASTE ON LOOP

[brunoricardo]

Hi guys!

I'm wondering how to build a macro for the following repetitive tasks:

1. Selecting a specific cell,
2. Goes to the last row with data,
3. Selects all the row, since the 3rd column until the end,
4. Cut all these cells
5. Pasts on the column A of the first blank row below the previous line,
6. It must repeat until finish all the columns with data.

To better explain, I letf here a video with a sample video on link below:

New Recording - 13_12_2021, 18_48_55.mp4

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Tanks a lot!

 

[Zot]

Select the starting cell with data in columns, then run this

Sub Test()

Application.ScreenUpdating = False
Restart:
Set Rng = Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 2).End(xlToRight))
Rng.Copy ActiveCell.Offset(1)
Rng.Clear
ActiveCell.Offset(1).Select
If Not Len(ActiveCell.Offset(0, 2)) = 0 Then GoTo Restart

End Sub

 

[Saurabhj]

Hi Brunoricardo,

Please use below code:

Sub arrangeData()
Dim lastRow As Integer, lastCol As Integer

lastRow = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
'MsgBox lastRow
Do While Sheets("Sheet1").Cells(lastRow, 3) <> ""
    lastCol = Sheets("Sheet1").Cells(lastRow, Columns.Count).End(xlToLeft).Column
    
    'MsgBox lastCol
    Sheets("Sheet1").Range("C" & lastRow).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut Sheets("Sheet1").Range("A" & lastRow + 1)
    lastRow = lastRow + 1
Loop
End Sub

 

[brunoricardo]

Hi Brunoricardo,

Please use below code:

Sub arrangeData()
Dim lastRow As Integer, lastCol As Integer

lastRow = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
'MsgBox lastRow
Do While Sheets("Sheet1").Cells(lastRow, 3) <> ""
    lastCol = Sheets("Sheet1").Cells(lastRow, Columns.Count).End(xlToLeft).Column
   
    'MsgBox lastCol
    Sheets("Sheet1").Range("C" & lastRow).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Cut Sheets("Sheet1").Range("A" & lastRow + 1)
    lastRow = lastRow + 1
Loop
End Sub

Thanks a lot! It works perfectly ??