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.