Reputation: 1155
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
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
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:
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
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