Macro to copy variable length table and paste numerous times in the same sheet

[rynardc]

Hi, might be something very easy, but been struggling with it for a while. I have a range of cells that gets populated by another macro, so the range of cells could be varied based on inputs from other macro. I need to copy the range of cells that was created by the other macro and paste it a couple of time below the last entry in the previous range, with a blank row inbetween. Hope this makes sense

 

[Joe4]

Welcome to the Board!

So much of this is dependent on your data structures. It would be most helpful if you could show us a sample of your data, and expected results (if you have any sensitive data, just "dummy it up" first before posting it).

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[rynardc]

Welcome to the Board!

So much of this is dependent on your data structures. It would be most helpful if you could show us a sample of your data, and expected results (if you have any sensitive data, just "dummy it up" first before posting it).

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

Hi
Thanks for the reply, it is actually not a very complex spreadsheet, the cells in question that needs to be copied basically have a row for the headings and then each row populated below the heading with the team info. So basically the headings will be Team Name, Skip Name, Points etc. I have a macro that allows Teams to be captured from a main sheet and then this macro populates these rows with the info. Once all the teams have been captured i just need to replicate the entries 5 or more times depending on how many rounds will be played.

 

[rynardc]

So Marked in yellow gets populated by the other Macro, marked in blue is what i`m trying to achieve with the new Macro, so however many fields are in the yellow part needs to be copied below and the Round count incremented

 

[Joe4]

Try this:

Sub MyCopy()

    Dim lr As Long
    Dim rng As Range
    Dim n As Long
    Dim i As Long
    Dim r As Long
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Set range to copy
    Set rng = Range("A2:G" & lr)
    
'   Prompt user for how many copies to make
    On Error GoTo err_fix
    n = InputBox("How many copies do you want to make?")
    On Error GoTo 0
    
'   Verify they entered a valid number greater than or equal to 1
    If n < 1 Then
        GoTo err_fix
    End If
        
    Application.ScreenUpdating = False
        
'   Loop through copies
    For i = 1 To n
'       Find row to place next entry on
        r = Cells(Rows.Count, "A").End(xlUp).Row + 2
'       Copy/paste original range
        rng.Copy Cells(r, "A")
'       Update header
        Cells(r, "A").Value = "Round " & i + 1
    Next i

    Application.ScreenUpdating = True
    
    Exit Sub
    
err_fix:
    MsgBox "You have not entered a valid integer greater than 0", vbOKOnly, "ENTRY ERROR!"
    
End Sub

 

[Kaper]

I can see that there is already the answer, but as I wrote the code (a bit similar), I'll show it.

You have not mentioned how this code shall be trigerred, nor what is the number of rounds - may be it is related to number of teams?

You can add a line:

Call test

in your original macro (probably just above End Sub statement) to have this code invoked automatically.

If the number of last round is hnown, you may use it in the text of the code. so the third line of below Sub could be replaced with

howmany = 3

if your expected result is exactly as shown on screenshots.

And the code itself:

Sub test()
Dim lr As Long, i As Long, howmany As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
howmany = CInt(InputBox("Give number of the last round?"))
For i = 2 To howmany
  Cells(Rows.Count, "A").End(xlUp).Offset(2, 0) = "Round " & i
  Range("A4:G" & lr).Copy Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
Next i
End Sub

 

[rynardc]

Hi Guys, many thanks for the replies. I want to automate the duplication process using a macro that is assigned to a button on the main page, so basically once all the teams have been captured using a form i created that is using another macro to basically populate the teams. Once all the teams have been populated i want to then use the new macro to just copy all the teams dependant on the number of rounds ,which might be a different number each time. Unfortunately i will now be giving away my inexperience with this asking my next question ,but how do i assign the VBA code you pasted to a macro ?

 

[rynardc]

Ok, so managed to figure out how to assign the VBA code to a macro, sorry for this. Next question if i may, how do i change the Tab or Sheet that this macro will be applied to as my form with the button calling the macro is on a different sheet than the sheet i want it applied

 

[Kaper]

You may add just after last Dim ..... line in both codes

Sheets("Name_of_Your_Sheet_like_Sheet1").Activate

or use such a construction:

Sub test2()
Dim lr As Long, i As Long, howmany As Long
with Sheets("YourSheetName")
  lr = .Cells(.Rows.Count, "A").End(xlUp).Row
  howmany = CInt(InputBox("Give number of the last round?"))
  For i = 2 To howmany
    .Cells(.Rows.Count, "A").End(xlUp).Offset(2, 0) = "Round " & i
    .Range("A4:G" & lr).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(2, 0)
  Next i
end with
End Sub

 

[rynardc]

Works Perfect ! Thanks for the help !