VBA：剪切一系列列并将其粘贴到前三列数据的底部

Question

I have data in an excel file in which there is data for separated into three columns: Date (column A), number (column B), number (column C).

This sequence gets repeated to column UI. I would like to cut the data in every three columns and paste it the last row + 1 in column a,b,c so I only have three columns of data. I am having trouble accounting for three columns of data in my code.

`Sub movedata()
Application.ScreenUpdating = False

Dim i As Integer

Set ws = ThisWorkbook.Sheets("Cashflow Chart")
    With ws
        lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column 'get last column using Row 1
        For i = 4 To lastcolumn  'loop though each column starting from 4
            Set Rng = .Range(.Cells(1, i), .Cells(.Cells(.Rows.Count, i).End(xlUp).Row, i)) 'set range to copy
            .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1).Resize(Rng.Rows.Count).Value = Rng.Value

    End With
    Application.ScreenUpdating = True
End Sub`

Answer 1

Fundimentally, change the For loop to step by 3's

Also, moving the data via a Variant Array will be faster, plus a few other things

Sub MoveData()
    Application.ScreenUpdating = False

    Dim i As Long
    Dim Data As Variant
    Dim LastColumn As Long
    Dim InsertRow As Long

    With ThisWorkbook.Sheets("Cashflow Chart")
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 'get last column using Row 1
        InsertRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'get insert point using column A
        For i = 4 To LastColumn Step 3  'loop though each column starting from 4, step by 3
            Data = .Range(.Cells(1, i + 2), .Cells(.Rows.Count, i).End(xlUp)).Value 'copy range to variant array
            .Cells(InsertRow, 1).Resize(UBound(Data, 1), 3).Value = Data 'place data at end of column A data
            InsertRow = InsertRow + UBound(Data, 1) 'increment insert point
        Next
        .Cells(1, 4).Resize(InsertRow, LastColumn - 3).ClearContents 'clear old data
    End With

    Application.ScreenUpdating = True
End Sub