Copy & Paste a range n times (n in a cell)

F

fontmar

New Member
Joined
Nov 3, 2016
Messages
12
Hi,
I've recorded the macro below.

a) It selects rows 1:52, copies and pastes on the cell A53 (so immediately below the last row that is empty)
b) Selects rows 53:104 copies and pastes on the cell A105 (same number of rows - 52 - starting from the cell immediately below the last row
c) in the cell M59 starts the incremental number with the formula (M5+1)
d) the cells have a special format, including some hidden rows

I need help to be able to past the 52 rows n times, starting from the first cell, column A, below the last row. The n number of times should be a value in the Sheet ("Data").Range ("H1").

Can I have some help to create the routine?

Thanks


Sub Macro3()
'
' Macro3 Macro
'
'
rows("1:52").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=36
Range("A53").Select
ActiveSheet.CheckBoxes.Add(720, 144.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(798, 144.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(681, 144.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(759, 144.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(493.5, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(513, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(531, 338.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(550.5, 338.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(569.25, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(588.75, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(705.75, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(727.5, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(747, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(765, 338.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(784.5, 338.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(803.25, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(822.75, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(471, 338.25, 22.5, 0).Select
ActiveSheet.Paste
Range("M57:P58").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-52]C+1"
Range("M59").Select
ActiveWindow.SmallScroll Down:=9
rows("53:104").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=51
Range("A105").Select
ActiveSheet.CheckBoxes.Add(720, 846.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(798, 846.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(681, 846.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(759, 846.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(493.5, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(513, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(531, 1040.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(550.5, 1040.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(569.25, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(588.75, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(705.75, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(727.5, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(747, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(765, 1040.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(784.5, 1040.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(803.25, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(822.75, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(471, 1040.25, 22.5, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
rows("105:156").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=45
Range("A157").Select
ActiveSheet.CheckBoxes.Add(720, 1548.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(798, 1548.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(681, 1548.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(759, 1548.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(493.5, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(513, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(531, 1742.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(550.5, 1742.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(569.25, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(588.75, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(705.75, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(727.5, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(747, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(765, 1742.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(784.5, 1742.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(803.25, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(822.75, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(471, 1742.25, 22.5, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
fontmar said:
Hi,
I've recorded the macro below.

a) It selects rows 1:52, copies and pastes on the cell A53 (so immediately below the last row that is empty)
b) Selects rows 53:104 copies and pastes on the cell A105 (same number of rows - 52 - starting from the cell immediately below the last row
c) in the cell M59 starts the incremental number with the formula (M5+1)
d) the cells have a special format, including some hidden rows

I need help to be able to past the 52 rows n times, starting from the first cell, column A, below the last row. The n number of times should be a value in the Sheet ("Data").Range ("H1").

Can I have some help to create the routine?

Thanks


Sub Macro3()
'
' Macro3 Macro
'
'
rows("1:52").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=36
Range("A53").Select
ActiveSheet.CheckBoxes.Add(720, 144.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(798, 144.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(681, 144.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(759, 144.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(493.5, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(513, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(531, 338.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(550.5, 338.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(569.25, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(588.75, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(705.75, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(727.5, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(747, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(765, 338.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(784.5, 338.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(803.25, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(822.75, 338.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(471, 338.25, 22.5, 0).Select
ActiveSheet.Paste
Range("M57:P58").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-52]C+1"
Range("M59").Select
ActiveWindow.SmallScroll Down:=9
rows("53:104").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=51
Range("A105").Select
ActiveSheet.CheckBoxes.Add(720, 846.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(798, 846.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(681, 846.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(759, 846.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(493.5, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(513, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(531, 1040.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(550.5, 1040.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(569.25, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(588.75, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(705.75, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(727.5, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(747, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(765, 1040.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(784.5, 1040.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(803.25, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(822.75, 1040.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(471, 1040.25, 22.5, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
rows("105:156").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=45
Range("A157").Select
ActiveSheet.CheckBoxes.Add(720, 1548.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(798, 1548.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(681, 1548.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(759, 1548.75, 19.5, 17.25).Select
ActiveSheet.CheckBoxes.Add(493.5, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(513, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(531, 1742.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(550.5, 1742.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(569.25, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(588.75, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(705.75, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(727.5, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(747, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(765, 1742.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(784.5, 1742.25, 21, 0).Select
ActiveSheet.CheckBoxes.Add(803.25, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(822.75, 1742.25, 21.75, 0).Select
ActiveSheet.CheckBoxes.Add(471, 1742.25, 22.5, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Click to expand...

Hello - if I understood your question right you can start with this, which includes a bit about if range("H1") is left blank:
Code: 
 Sub copy52()
Dim i, a As Long


If Worksheets("Data").Range("H1") = "" Then
    MsgBox ("Please enter the number of times you want to copy the 52 cells in cell H1.")
    Worksheets("Data").Range("H1").Interior.ColorIndex = 6
    Exit Sub
Else
    Worksheets("Data").Range("H1").Interior.ColorIndex = 0
End If
a = 53
With Sheets("Data")
    For i = 1 To Range("H1")
        Range(Cells(1, 1), Cells(52, 1)).Copy _
            Destination:=Range(Cells(a, 1), Cells(a + 52, 1))
        a = a + 52
    Next i


End With
End Sub
I hope this helps - JA
 
Upvote 0
Hi, when I run the macro nothing happens. It's not copying...
Just to clarify, the worksheet where the macro should copy and paste the 52 rows is not "Data", but "Final": maybe that's the reason why it doesn't work
 
Upvote 0
fontmar said:
Hi, when I run the macro nothing happens. It's not copying...
Just to clarify, the worksheet where the macro should copy and paste the 52 rows is not "Data", but "Final": maybe that's the reason why it doesn't work
Click to expand...
I don't see that in your description, but really all you do is change the destination and play around with it to your exact needs.
Remove the Red, Add the Blue, Adjust the Green
Code: 
[COLOR=#ff0000]With Sheets("Data") 'Remove this line and the End With below[/COLOR]
    For i = 1 To Range("H1")
        [COLOR=#0000cd]Worksheets("Data")[/COLOR].Range(Cells(1, 1), Cells(52, 1)).Copy _
            Destination:=[COLOR=#0000cd]Worksheets("Final").[/COLOR]Range(Cells([COLOR=#008000]a[/COLOR], 1), Cells([COLOR=#008000]a + 52[/COLOR], 1)) [COLOR=#008000]'Adjust the green to fit where you exactly want the 52 cells copied[/COLOR]
        [COLOR=#008000]a = a + 52[/COLOR]
    Next i


[COLOR=#ff0000]End With ' Remove[/COLOR]
It will take a little bit of playing around if you are unfamiliar with coding. I would suggest taking my code into a blank workbook, changing the sheet name to "Data", then marking each of the 52 cells in range("A1:A52") with a unique number. Play around, try adding a blank between each of the 52 sets of data. This will get you familiar with the code so you can play with it according to your needs.
JA
 
Upvote 0
So...after re-reading your description and your response, the only info from Sheets("Data") is the number of times you want the 52 cells copied. If that is the case then try this:
Code: 
Sub copy52()
Dim i, a As Long

If Worksheets("Data").Range("H1") = "" Then
    MsgBox ("Please enter the number of times you want to copy the 52 cells in cell H1.")
    Worksheets("Data").Range("H1").Interior.ColorIndex = 6
    Exit Sub
Else
    Worksheets("Data").Range("H1").Interior.ColorIndex = 0
End If
a = 53
For i = 1 To Worksheets("Data"). Range("H1")
     Worksheets("Final").Range(Cells(1, 1), Cells(52, 1)).Copy _
          Destination:=Worksheets("Final").Range(Cells(a, 1), Cells(a + 52, 1))
     a = a + 52
Next i
End Sub

JA
 
Upvote 0
jimayers said:
So...after re-reading your description and your response, the only info from Sheets("Data") is the number of times you want the 52 cells copied. If that is the case then try this:
Code: 
Sub copy52()
Dim i, a As Long

If Worksheets("Data").Range("H1") = "" Then
    MsgBox ("Please enter the number of times you want to copy the 52 cells in cell H1.")
    Worksheets("Data").Range("H1").Interior.ColorIndex = 6
    Exit Sub
Else
    Worksheets("Data").Range("H1").Interior.ColorIndex = 0
End If
a = 53
For i = 1 To Worksheets("Data"). Range("H1")
     Worksheets("Final").Range(Cells(1, 1), Cells(52, 1)).Copy _
          Destination:=Worksheets("Final").Range(Cells(a, 1), Cells(a + 52, 1))
     a = a + 52
Next i
End Sub

JA
Click to expand...
Thank you JA,

I had to play a little bit and now it works perfectly.
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,268
Messages
6,171,099
Members
452,379
Latest member
IainTru

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top