Copy and Paste Macro

[motherteresa]

I have a workbook with 3 worksheets in it. Each worksheet needs a various number of duplicate pages. In other words, the info on the page is like a template that needs to be copied downward. The page contains formulas and a macro attached to a button.

I have the Workbook created, with 1 page in each of those 3 worksheets. Our school consultants will then use their copy of the workbook and, depending on the client's needs, will need each worksheet's page copied and pasted a number of times. For example:

Ann needs
Wrksht 1 - 10 pages
Wrksht 2 - 15 pages
Wrksht 3 - 7 pages

Sue needs
Wrksht 1 - 30 pages
Wrksht 2 - 35 pages
Wrksht 3 - 15 pages

I could just create, say, 50 pages in each worksheet and then distribute the workbook to each consultant. But I was wondering if a macro could be written to copy everything on a page and then paste it x number of times...x being somehow defined by the user for each case.

So, for worksheet 1, the macro would copy rows 1-42 and then paste it to cell A43, A85, A127 and so on depending on how many copies were needed. This macro would be attached to a form(?) where a number indicating the number of copies desired could be input.

Thanks for any help. Hope I've explained it thoroughly enough.

 

[AlphaFrog]

Set the red items in the macro to define the "1st page" rows on each worksheet.

The macro will prompt the user for the number of "pages" they want duplicated on each sheet.

If you want to copy a command button, the button has to be within the 1st page range and it has to be a Forms control type command button and not a command button from the Control Toolbox toolbar or ActiveX type button. The ActiveX type buttons don't copy with the method used in the macro.(Types of command buttons)

Sub Duplicate_Pages()

    Dim rng(1 To 3) As Range
    Dim pgs(1 To 3) As Variant
    Dim i As Integer
    
    Set rng(1) = Sheets("[COLOR="Red"]Sheet1[/COLOR]").Range("[COLOR="Red"]1:15[/COLOR]")   [COLOR="Green"]' 1st Page rows on Sheet1[/COLOR]
    Set rng(2) = Sheets("[COLOR="Red"]Sheet2[/COLOR]").Range("[COLOR="Red"]1:20[/COLOR]")   [COLOR="Green"]' 1st Page rows on Sheet2[/COLOR]
    Set rng(3) = Sheets("[COLOR="Red"]Sheet3[/COLOR]").Range("[COLOR="Red"]1:30[/COLOR]")   [COLOR="Green"]' 1st Page rows on Sheet3[/COLOR]
    
    [COLOR="Green"]' Prompt user for duplicated pages input[/COLOR]
    For i = 1 To 3
        pgs(i) = Application.InputBox("Enter the number of pages you want duplicated on " & Sheets(i).Name & "...", _
                                      Title:="Pages on " & Sheets(i).Name, Default:=1, Type:=1)
        If pgs(i) = False Then Exit Sub  [COLOR="Green"]' User selected cancel[/COLOR]
        
        [COLOR="Green"]' Input limited to 100 pages (arbitrary limit)[/COLOR]
        If pgs(i) > 100 Then
            pgs(i) = 100
            MsgBox "Input set to 100", vbInformation, "Duplicated Pages Limited to 100"
        End If
        
    Next i
    
    [COLOR="Green"]' Duplicate pages[/COLOR]
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For i = 1 To 3
        If pgs(i) > 1 Then
            rng(i).Copy Destination:=rng(i).Resize(rng(i).Rows.Count * pgs(i))
        End If
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

 

[motherteresa]

OK. I recorded a macro to copy and paste. Here it is.

Sub copy_paste()
'
' copy_paste Macro
'

'
    Rows("1:42").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=39
    Range("A43").Select
    ActiveSheet.Buttons.Add(9.75, 169.5, 55.5, 21.75).Select
    ActiveSheet.Paste
End Sub

Now, how do I get it to paste it the number of times I want it to a set number of rows down (42) for each copy?

For instance, is there a way to designate a cell where I could type in the number 25, click a button (or run the macro) and it would paste 25 copies?

Also what does this line refer to?

ActiveSheet.Buttons.Add(9.75, 169.5, 55.5, 21.75).Select

 

[motherteresa]

AlphaFrog -

You're like an Excel Super Hero! I'll try it out and let you know. My reply after your reply was actually in the works before I saw your reply.

Uggh, time warp!


OH...where does the code you wrote get pasted to??

 

[AlphaFrog]

Paste it in any standard module. It could be in the same module as your recorded macro.

 

[Smitty]

See if this gets you started:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> foo()<br>    <SPAN style="color:#00007F">Dim</SPAN> x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, y <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>        y = Application.InputBox("How many times do you want to copy the current sheet?", "Copy Current Sheet", Type:=1)<br>        <br>        <SPAN style="color:#00007F">For</SPAN> x = 1 <SPAN style="color:#00007F">To</SPAN> y<br>            Range("A1:I42").Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>        <SPAN style="color:#00007F">Next</SPAN> x<br>                    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

EDIT: too slow - never let a 6 year old interrupt you while trying to post.

 

[motherteresa]

AlphaFrog -

I am so sorry, but apparently I gave some errant info. It turns out the worksheets are "technically" numbered (in the order of the tabs at the bottom) 13, 12 and 7. Yeah...I have no idea why. Again, sorry for the flub. They are "named", btw. 13 is "STUDENT", 14 is "MEDICAL" and 7 is "ADMINISTRATION"

I mention all this because when I test ran the macro it asked for how many copies I wanted for the ACCOUNT worksheet, which is the REAL worksheet number 1.

Sorry!

ps - I had already figured it must go in a module. Thanks.

 

[AlphaFrog]

Sub Duplicate_Pages()
    
    Dim ws(1 To 3) As Worksheet
    Dim rng(1 To 3) As Range
    Dim pgs(1 To 3) As Variant
    Dim i As Integer
    
    Set ws(1) = Sheets("[COLOR="Red"]STUDENT[/COLOR]")           ' 1st worksheet
    Set ws(2) = Sheets("[COLOR="Red"]MEDICAL[/COLOR]")           ' 2nd worksheet
    Set ws(3) = Sheets("[COLOR="Red"]ADMINISTRATION[/COLOR]")    ' 3rd worksheet
    
    Set rng(1) = ws(1).Range("1:15")   ' 1st Page rows on 1st sheet
    Set rng(2) = ws(2).Range("1:20")   ' 1st Page rows on 2nd sheet
    Set rng(3) = ws(3).Range("5:30")   ' 1st Page rows on 3rd sheet
    
    ' Prompt user for duplicated pages input
    For i = 1 To 3
        pgs(i) = Application.InputBox("Enter the number of pages you want duplicated on " & ws(i).Name & "...", _
                                      Title:="Pages on " & ws(i).Name, Default:=1, Type:=1)
        If pgs(i) = False Then Exit Sub  ' User selected cancel
        
        ' Input limited to 100 pages (arbitrary limit)
        If pgs(i) > 100 Then
            pgs(i) = 100
            MsgBox "Input set to 100", vbInformation, "Duplicated Pages Limited to 100"
        End If
        
    Next i
    
    ' Duplicate pages
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For i = 1 To 3
        If pgs(i) > 1 Then
            rng(i).Copy Destination:=rng(i).Resize(rng(i).Rows.Count * pgs(i))
        End If
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

 

[motherteresa]

Smitty -

Thanks also! BTW, I'm the Biggest Calvin & Hobbes Fan.

I pasted your code in the worksheet object and got a rude sound and an
Error 400

Then, I tried pasting it in a module and got a
'Run-time Error' 1004:
Copy Method of Range Class Failed

 

[motherteresa]

AlphaFrog -

Thanks. I tried it and it copy and pastes great with just one issue.

All of cells that are merged in the beginning came out as unmerged after the pasting. Is there a way to fix that?

Thanks for your help.