Hi,

there is a Camera tool that you can add to the Quick Access Toolbar (it's called "Camera") - to add, click the dropdown arrow at the end of the QAT and select "More Commands…", then change the "Choose commands from:" box to "All Commands"; find the Camera command in the large selection below and double-click it and click "OK" to close

when clicked it will take a snapshot of the currently selected area which can then be pasted (with your next click on any cell); for example to a new "printout" sheet
these images will update to reflect any changes to the original selection (including any graphics overlaying them, even partially so)

do this for each of your required selections and rearrange to your heart's content (beware, this can waste a lot of your time!)

hope this works for you,

jim

Hello,

another solution, using VBA



put the following code in a userform module
if you don't want a userform, it can be placed in the standard module, without this part Private Sub CommandButton1_Click() & disable this part: Unload Me 

and the macro can be called by a control (command button or shape) on the excel sheet


you can select the area you want to print on each of the sheets as shown in this part of the code:
If sht.Name = "Sheet2" Then ' select sheet name (change the name)
Set arrInput(i) = sht.Range(sht.Range("A1"), ("K17")) 

or if you don't have charts, images or shapes on the sheet or just want to print the cell data for the whole sheet

Set arrInput(i) = sht.Range(sht.Range("A1"), rng)

for those who want to print only the data for all sheets, disable the parts of the code to select area

I left the macro on print preview mode
the print out is disabled, you have 2 options, activate only one of them

Option Explicit

Private Sub CommandButton1_Click()
Call Print_All_In_One_Page
End Sub

Public Sub Print_All_In_One_Page()

Dim shtPrint As Worksheet, sht As Worksheet
Dim arrInput() As Range, rng As Range
Dim i As Integer

On Error Resume Next
ReDim arrInput(1 To 1)
On Error GoTo 0

'' * if data is missing from any worksheet cells, they will be ignored
'For Each sht In Application.ThisWorkbook.Sheets ' to select Sheets & WorkSheets
For Each sht In Application.ThisWorkbook.Worksheets ' only to select WorkSheets
      i = i + 1
      If i > 1 Then
            ReDim Preserve arrInput(1 To i)
      End If
      On Error Resume Next
      Set rng = sht.Cells.SpecialCells(xlCellTypeLastCell)
      If Err = 0 Then
            On Error GoTo 0
            Do While Application.CountA(rng.EntireRow) = 0 And rng.EntireRow.Row > 1
                  Set rng = rng.Offset(-1, 0)
            Loop
            If sht.Name = "Sheet2" Then                                           ' select sheet name
                  Set arrInput(i) = sht.Range(sht.Range("A1"), ("K17")) ' select area - ex: if there are shapes or charts on the sheet and we also want
            ElseIf sht.Name = "Sheet4" Then                                     ' select sheet name
                  Set arrInput(i) = sht.Range(sht.Range("A1"), ("K17")) ' select area - ex: if there are shapes or charts on the sheet and we also want

           'ElseIf ...
            Else
                  Set arrInput(i) = sht.Range(sht.Range("A1"), rng)       ' only data in cells (no shapes & charts even if they exist)
            End If
      End If
Next sht

Set shtPrint = Sheets.Add(after:=Worksheets(Worksheets.Count)) ' add new sheet at the end

On Error Resume Next
With shtPrint
      For i = 1 To UBound(arrInput)
            If i = 1 Then
                  Set rng = .Range("A1")
            Else
                  Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
                  Set rng = rng.Offset(3, 0).End(xlToLeft) ' add rows between data sheets
            End If
            If Application.CountA(arrInput(i)) > 0 Then
                  arrInput(i).Copy rng
            End If
      Next i
End With
On Error GoTo 0

Application.CutCopyMode = False

With ActiveSheet.PageSetup ' in one page
      .Zoom = False
      .FitToPagesWide = 1
      .FitToPagesTall = 1
End With

Unload Me ' in case the macro has been activated in a userform
ActiveWindow.SelectedSheets.PrintPreview ' print preview

''------------------------------------------------------------
''--- activate only one option - OPTION 1 - select number of copies
''* indicate the number of copies
'retry:
'i = InputBox("How many print copies do you want?", "Please confirm!", 1)
'If IsNumeric(i) Then
'      If i = 0 Then MsgBox "The number of copies must be greater than 0!", vbCritical, "An error has occurred!": GoTo retry:
'            If i > 0 and i < 10 Then
'                   ActiveSheet.PrintOut Copies:=i
'             Else
'                  MsgBox "The number of copies must be less than 10!", vbCritical, "An error has occurred!": GoTo retry:
'             End If
'      Else
'            MsgBox "The number of copies must be inserted only in number, not in letters or symbols!", vbCritical, "An error has occurred!": GoTo retry:
'End If
''------------------------------------------------------------

''------------------------------------------------------------
''--- activate only one option - OPTION 2 - only one copie
' ActiveSheet.PrintOut ' print out
''------------------------------------------------------------

Application.DisplayAlerts = False
shtPrint.Delete
Application.DisplayAlerts = True

If Not rng Is Nothing Then Set rng = Nothing
If Not shtPrint Is Nothing Then Set shtPrint = Nothing

End Sub

 

Miguel,