在一份工作中多次打印相同的工作表

我试图多次打印同一个工作表作为一个打印作业。 我有一个工作表，具有列ID ， FirstName ， LastName和Age 。 我有另一个工作表，就像一个表单。 用户select一个ID，其余的列自动填充（ First Name, LastName, and Age ）。 我已经有了一些代码，一旦用户从下拉菜单中select了他们想要的ID，工作表会自动更新该ID的信息。 我正在试图添加一个macros将打印每个ID相同的工作表。 所以，如果我有2个ID例如：

1. 代码将使用我现有的macros用ID1更新工作表
2. 打印工作表
3. 使用我的代码来更新ID2的工作表
4. 打印工作表

最后，我想有一个印有两张纸的作业。

我已经知道我可以使用下面的代码分别打印工作表：

 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 

但是我需要把所有的印刷品作为一个印刷工作出来，所以如果他们select了PDF格式的话，它会被打印成一个pdf文档而不是数百个。

我也发现这种方法将打印一张纸张的数组，但它仍然不让我更新打印之间的工作表。

 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 

Answer 1

试试这个 – 调整原始数据 – 我在这个代码中每20行假设不同的logging。

 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