简体   繁体   中英

Copy and Paste to next empty row

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

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

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