Print same worksheet multiple times in one job

Question

I am attempting to print the same worksheet multiple times as one print job. I have a worksheet that has a table with columns ID, FirstName, LastName, and Age. I have another worksheet that acts like a form. Users select an ID and the rest of the columns get automatically populated (First Name, LastName, and Age). I already have code that once the user selects which ID they want from a dropdown, the sheet updates with the information for that ID automatically. I am trying to add a macro that will print the same worksheet for each ID. So if I had 2 id's for example:

the code will use my existing macro to update the worksheet with ID1
print the worksheet
use my code to update the worksheet with ID2
print the worksheet

In the end though, I would like to have one print job that has both sheets in it.

I already know I could use the below code to print the worksheets separate:

Sub PrintForms()
    dim myID as integer

'myID gets the last ID numer    
myID = sheets("CondForm").Range("A1").Value

for i = 1 to myID
    'this just takes the ID number from i and updates the worksheet with the data for that id
    call misc.UpdateSheet(i)
    Sheets("Data Form").PrintOut
Next i

End Sub

But I need all of the prints to come out as one print job so that if they chose pdf for example it gets printed as one pdf document and not hundreds.

I also found this method that will print an array of sheets, but it still doesn't let me update the sheet between prints.

Sub PrintArray()
    Dim SheetsToPrint   As String
    Dim MyArr()         As String

SheetsToPrint = "Data Table,Data Form"

'Split the string into an array
MyArr = Split(SheetsToPrint, ",")

ThisWorkbook.Worksheets(MyArr).PrintOut

End Sub

I would create a worksheet, then paste the first page on A1, find the last row, and insert a page break, go to lastrow + 1, insert second page, find lastrow again, insert page break, goto lastrow + 1, insert 3rd page, and so on until you have all pages on a single worksheet. Print it out, and then delete the new worksheet. — John Muggins
That's a good idea. I was thinking about just creating a new sheet for each ID, but that could get messy with a 100 or so id's. But the page break idea isn't bad. — Hasib_Ibradzic

John Muggins John Muggins · Accepted Answer · 2017-02-17T15:00:55

try this - adjust the original data - I assumed different records every 20 rows in this code.

Sub testit()
Dim ws As Worksheet, lastRow As Long, originalWS As Worksheet
Dim originalRowCounter As Long, wsRowCounter As Long, numberRecords As Long
Dim i As Long

    Application.ScreenUpdating = False
    Set originalWS = ActiveSheet
    Set ws = Sheets.Add
    originalRowCounter = 1
    wsRowCounter = 1
    originalWS.Activate

    '   Assume every 20 rows on originalWS has idividual record - adjust this accordingly
    lastRow = originalWS.Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Row + 1
    numberRecords = lastRow / 20
    For i = 1 To numberRecords
        originalWS.Range("A" & originalRowCounter & ":K" & (originalRowCounter + 19)).Select
        Selection.Copy
        ws.Activate
        ws.Range("A" & wsRowCounter).Activate
        ActiveSheet.Paste
        originalRowCounter = originalRowCounter + 20
        wsRowCounter = wsRowCounter + 20
        ws.Rows(wsRowCounter).PageBreak = xlPageBreakManual
        originalWS.Activate
    Next i
    Application.PrintCommunication = False
    With ws.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    Application.PrintCommunication = True
    ws.PrintOut
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True



Application.ScreenUpdating = True
Set originalWS = Nothing
Set ws = Nothing
End Sub

Print same worksheet multiple times in one job

1 Answers