Joe Heiler
Joe Heiler

Reputation: 5

Creating a Copy/Paste VBA loop

I have a massive data set (1000s of values) in a large spreadsheet, and I need to copy and paste these values into a new sheet in sets of 10. Essentially I need to copy the first 10 cells in a column and paste them into their own column in a new sheet. I then need to repeat this with cells 11-20 and paste them into their own column in a new sheet. So: copy 1-10, paste into new sheet in column A. Then copy 11-20 and paste into same new sheet, column B. 21-30 in column C, and so on.

I have already tried some basic code, I am really new to this but find it interesting. I have figured out how to copy a range of 10 and paste to a new sheet, but I do not know how to set the loop up so I can continue this process into new columns with increasing sets of 10. I also have tried recording a macro, however it just recreates literally the keystrokes I input which isn't useful to me.

I wrote this to copy first 10 in my source column and paste to my new sheet in their new column.

Option Explicit
Sub CopyCells()
Worksheets("Sheet1").Range("A3:A12").Copy Worksheets("Sheet2").Range("B2:B11")
End Sub

I need it to loop and continuously cut and paste sets of 10 cells from one target column into a new sheet, and each set of 10 into their own new column. If you post an answer could you please add explanations as well? I really like this stuff and am trying to learn, not just copy paste some code. Thanks!

Upvotes: 0

Views: 485

Answers (1)

Tim Williams
Tim Williams

Reputation: 166126

You can do something like this:

Sub CopyCells()
    Const NUM_ROWS As Long = 10  'size of block to copy
    Dim rngCopy As range, col As Long

    Set rngCopy = Worksheets("Sheet1").Range("A3").Resize(NUM_ROWS, 1)
    col = 2
    'copy while rngCopy has any data
    Do While Application.Counta(rngCopy) > 0
        rngCopy.Copy Worksheets("Sheet2").Cells(2, col)
        col = col + 1                       'increment destination column
        Set rngCopy = rngCopy.Offset(NUM_ROWS, 0) 'move copy range down 10
    Loop

End Sub

Upvotes: 1

Related Questions