j2associates
j2associates

Reputation: 1155

Can you print 2 Excel sheets side by side in the same page

The Print Layout Pages per Sheet allows you to set the value, but the number of sheets then prints vertically

    Sheet1
    Sheet2

I need them to print side by side instead with each sheet taking up 50%

    S    S
    h    h
    e    e
    e    e
    t    t
    1    2

Can this be done?

Upvotes: 0

Views: 417

Answers (3)

Nadir Madrid
Nadir Madrid

Reputation: 1

this vba code doing the job:

Sub PrintSheetsSideBySide()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim tempSheet As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim sheetName1 As String, sheetName2 As String
    Dim answer As VbMsgBoxResult

    ' Prompt user to select the first sheet
    sheetName1 = InputBox("Enter the name of the first sheet to print:", "Select First Sheet")
    On Error Resume Next
    Set ws1 = ThisWorkbook.Sheets(sheetName1)
    If ws1 Is Nothing Then
        MsgBox "Sheet '" & sheetName1 & "' does not exist!", vbExclamation, "Error"
        Exit Sub
    End If
    On Error GoTo 0

    ' Prompt user to select the second sheet
    sheetName2 = InputBox("Enter the name of the second sheet to print:", "Select Second Sheet")
    On Error Resume Next
    Set ws2 = ThisWorkbook.Sheets(sheetName2)
    If ws2 Is Nothing Then
        MsgBox "Sheet '" & sheetName2 & "' does not exist!", vbExclamation, "Error"
        Exit Sub
    End If
    On Error GoTo 0

    ' Confirm with the user before proceeding
    answer = MsgBox("You have selected the following sheets:" & vbCrLf & _
                    "1. " & sheetName1 & vbCrLf & _
                    "2. " & sheetName2 & vbCrLf & _
                    "Do you want to proceed?", vbYesNo + vbQuestion, "Confirm Selection")
    If answer = vbNo Then Exit Sub

    ' Check if print areas are defined for both sheets
    If ws1.PageSetup.PrintArea = "" Or ws2.PageSetup.PrintArea = "" Then
        MsgBox "Both sheets must have a defined print area!", vbExclamation, "Error"
        Exit Sub
    End If

    ' Create a temporary sheet for combining the data
    Application.DisplayAlerts = False
    On Error Resume Next
    Set tempSheet = ThisWorkbook.Sheets("TempPrintSheet")
    If Not tempSheet Is Nothing Then tempSheet.Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set tempSheet = ThisWorkbook.Sheets.Add
    tempSheet.Name = "TempPrintSheet"

    ' Copy data from the first sheet's print area
    Set rng1 = ws1.Range(ws1.PageSetup.PrintArea)
    rng1.Copy
    tempSheet.Range("A1").PasteSpecial Paste:=xlPasteAll

    ' Copy data from the second sheet's print area
    Set rng2 = ws2.Range(ws2.PageSetup.PrintArea)
    rng2.Copy
    tempSheet.Cells(1, rng1.Columns.Count + 2).PasteSpecial Paste:=xlPasteAll ' Leave a gap between the sheets

    ' Adjust column widths and row heights
    tempSheet.Columns.AutoFit
    tempSheet.Rows.AutoFit

    ' Set page layout to landscape, narrow margins, and maximize page fill
    With tempSheet.PageSetup
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        
        ' Set narrow margins (as close to 0 as possible)
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        
        ' Center content horizontally and vertically
        .CenterHorizontally = True
        .CenterVertically = True
    End With

    ' Print the temporary sheet
    tempSheet.PrintOut

    ' Delete the temporary sheet
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True

    MsgBox "Printing complete!", vbInformation, "Success"
End Sub

Upvotes: 0

JoMo
JoMo

Reputation: 1

Another option could be to create a third sheet, copy the range from Sheet1 you want and paste it as Linked Picture (in the Paste dropdown, Other Paste Options, to the right) on Sheet3, resize to fit, and then do the same with Sheet2:

enter image description here

The advantage is that it updates when changes happen on sheet1 and 2 and you can add other text and formatting, the downside is that it increases the size of the workbook, and if you have a complex workbook, it might increase the risk of problems.

Upvotes: 0

FaneDuru
FaneDuru

Reputation: 42256

Please, try the next workaround. It joins the two sheets side by side in a temporary workbook, appropriately set PageSetup, PrintOut then, close the temporary wbP:

Sub TwoSheetsPerPage()
   Dim wb As Workbook, sh1 As Worksheet, sh2 As Worksheet, wbP As Workbook, lastCol As Long
   
   Set wb = ActiveWorkbook
   Set sh1 = wb.Worksheets(1)
   Set sh2 = wb.Worksheets(2)
   
   sh1.Copy 'this creates a new workbook with only the content of the first sheet
   
   Set wbP = ActiveWorkbook
   Set sh1 = wbP.Sheets(1)
   lastCol = sh1.cells.SpecialCells(xlCellTypeLastCell).column
   
   'join the two sheets content, side by side
   With sh2.UsedRange
        sh1.cells(1, lastCol + 1).Resize(.rows.count, .Columns.count).Value = .Value
   End With
   
   
   'setting the PageSetup to accept all  columns:
   With sh1.PageSetup
        .PrintArea = sh1.UsedRange.address
        .FitToPagesWide = 1
   End With
   
   'print the newly created workbook
    sh1.PrintOut copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    wbP.Close False 'close the temporary workbook
End Sub

Upvotes: 1

Related Questions