Copy and Paste to next empty row

Question

I have a macro that copies a range, pastes the range a certain number of times based on another cells value into Sheet2, however it's overlapping each set in the loop rather than pasting into the next open cell in Column A...

This is what I have so far:

Dim rng As Range
Dim r As Range
Dim numberOfCopies As Integer
Dim n As Integer
Dim lastrow As Long

'## Define a range to represent ALL the data
Set rng = Sheets("Sheet1").Range("A3", Sheets("Sheet1").Range("C3").End(xlDown))
lastrow = Sheets("Sheet2").Range("A65536").End(xlUp).Row
'## Iterate each row in that data range
For Each r In rng.Rows
    '## Get the number of copies specified in column 14 ("N")
    numberOfCopies = r.Cells(1, 35).Value

    '## If that number > 1 then make copies on a new sheet
    If numberOfCopies > 1 Then
        '## Add a new sheet
        With Worksheets("Sheet2")


            '## copy the row and paste repeatedly in this loop

            For n = 1 To numberOfCopies
                r.Copy .Range("A" & n)
            Next
        End With
    End If

n always starts again at 1 in each iteration of your r loop. Use your lastrow variable. — SJR
changed it to: r.Copy .Range("A" & lastrow) and still overwrites each other. — Scott Woodhall
Because you haven't updated lastrow after entering the loop. BTW your comment has column 14 but your code has 35. — Tim Williams
Oh thanks! Didn't catch that in my comment, ty. I'm sorry what do you mean by updating lastrow. How would you change the code? I'm a total novice at some of this stuff, sorry. — Scott Woodhall

SJR SJR · Accepted Answer · 2019-12-16T17:38:56

Try this. I haven't tested it so let me know if it doesn't work properly.

I've added a few comments.

I think you can dispense with the inner loop by using Resize.

Sub x()

Dim rng As Range
Dim r As Range
Dim numberOfCopies As Long 'use long rather than integer
Dim n As Long
Dim lastrow As Long

'## Define a range to represent ALL the data
With Sheets("Sheet1")
    Set rng = .Range("A3", .Range("C" & Rows.Count).End(xlUp)) 'work up from the bottom rather than top down
End With
'## Iterate each row in that data range
For Each r In rng.Rows
    '## Get the number of copies specified in column 14 ("N")
    numberOfCopies = r.Cells(1, 35).Value
    '## If that number > 1 then make copies on a new sheet
    If numberOfCopies > 1 Then
        '## Add a new sheet
        With Worksheets("Sheet2")
            '## copy the row and paste repeatedly in this loop
            lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1 'want the row below last used one
            r.Copy .Range("A" & lastrow).Resize(numberOfCopies)
        End With
    End If
End Sub

Copy and Paste to next empty row

1 Answers