Using checkbox to select multiple sheets and print with headers

[suntzu_2002]

I'm using the following code to allow users to select multiple sheets within a workbook. It will then print out 6 copies of each sheet with a different header. The code will probably look familiar to a lot of you since I think I grabbed it from this forum with some minor changes made by me.

The problem is that these are not collated and it can take a lot of time to collate them by hand. I need all the customer copies together, all the shop copies together, etc...

I was trying to get the code to take each checkbox, add the sheet name to an array, and print the array of all sheets 6 times with the different header, and different print area for the Shop copy.

Can anyone help me get started?

Thank you!

Sub PrintCopies()
    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim cb As CheckBox
    Dim lRow As Long
    Application.ScreenUpdating = False

'   Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If

'   Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

'   Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Worksheets.Count
        Set CurrentSheet = ActiveWorkbook.Worksheets(i)
'       Skip empty sheets and hidden sheets
        If Application.CountA(CurrentSheet.Cells) <> 0 And _
            CurrentSheet.Visible Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
                PrintDlg.CheckBoxes(SheetCount).Text = _
                    CurrentSheet.Name
            TopPos = TopPos + 13
        End If
    Next i

'   Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = 240

'   Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = Application.Max _
            (68, PrintDlg.DialogFrame.Top + TopPos - 34)
        .Width = 230
        .Caption = "Select sheets to print"
    End With

'   Change tab order of OK and Cancel buttons
'   so the 1st option button will have the focus
    PrintDlg.Buttons("Button 2").BringToFront
    PrintDlg.Buttons("Button 3").BringToFront

'   Display the dialog box
    CurrentSheet.Activate
    Application.ScreenUpdating = True
    If SheetCount <> 0 Then
        If PrintDlg.Show Then
            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                    Worksheets(cb.Caption).Activate
                    With ActiveSheet
'                   Prints out copies with custom headers and adjusts print area
                    .PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Customer Copy*"
                    lRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row
                    ActiveSheet.PageSetup.PrintArea = Range("A1", "K" & lRow).Address
                    .PrintOut
                    .PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Carrier Copy*"
                    .PrintOut
                    .PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Office Copy*"
                    .PrintOut
                    .PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Transportation Copy*"
                    .PrintOut
                    .PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Scheduler's Copy*"
                    .PrintOut
                    .PageSetup.CenterHeader = "&""Arial,bold""&20" & "*SHOP COPY*"
                    lRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
                    ActiveSheet.PageSetup.PrintArea = Range("A1", "M" & lRow).Address
                    .PrintOut
                    .PageSetup.CenterHeader = ""
'                   ActiveSheet.PrintPreview 'for debugging
                    End With
                End If
            Next cb
        End If
    Else
        MsgBox "All worksheets are empty."
    End If

'   Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete

'   Reactivate original sheet
    CurrentSheet.Activate
End Sub