简体   繁体   中英

VBA Copy and Paste to Row +1 below

I'm trying to write some code that will copy and paste data in cells A3:A6 to A8:A11 and then when run again it will paste it the row +1 beneath, so the next time it's run the data in A8:A11 will be copy and pasted into A13:A16 and the next time after that it's run it will paste the data in A13:16 to A18:21 and so on.

The below is what I've tried to come up with but I might be quite a way off, any guidance will be appreciated:

Sub RollFile()

Dim UsdRows As Long

UsdRows = Cells(Rows.Count, 3).End(xlToUp).Row
With Range(Cells(1, UsdRows), Cells(UsdRows, 1))
  .Copy .Offset(, 1)
  .Value = .Value
  .Offset(-1, 1)(1).Select
End With

End Sub

Many thanks

I suggest the following:

Option Explicit

Public Sub RollFile()
    Const RowsToCopy As Long = 4 'amount of rows that should be copied

    Dim LastCell As Range
    Set LastCell = Cells(Rows.Count, "A").End(xlUp) 'last cell in col A

    With LastCell.Offset(RowOffset:=-RowsToCopy + 1).Resize(RowSize:=RowsToCopy) '= last 4 cells (4 = RowsToCopy)
        .Copy LastCell.Offset(RowOffset:=2)
        .Value = .Value 'not needed I think
    End With
End Sub

It looks for the last used cell in column A. Then selects the previous 4 cells from there and copies that 2 rows below.

Note that I think .Value = .Value is not needed at all because that only makes sense if formulas were copied that need to be transformed into values.

you could try this

Sub RollFile()

    With Cells(Rows.Count, 1).End(xlUp) ' reference column A last not empty cell
        With Range(.End(xlUp), .Cells) ' reference the range from referenced cell up to last adjacent one
            .Offset(.Rows.Count + 1).Value = .Value ' copy referenced range values to a range two row below its end
        End With
    End With

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM