print 3 sheets

KlausW

Active Member
Joined
Sep 9, 2020
Messages
378
Office Version
  1. 2016
Platform
  1. Windows
Hi I would like to print 3 sheets called 1st division, 2nd division. 3rd division, with Range A1 to N40. One side of each. Someone who can help. I use this VBA code.

Any help will be much appreciated.
Many Thanks

Klaus W

VBA Code:
Private Sub cbPrint_Click()
    '
    ' Udskriver bestilling
    '
    Range("A1:N40").Select
    ActiveSheet.PageSetup.PrintArea = "A1:N40"
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True
    End Sub
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
VBA Code:
Sub Possibly()
Dim shArr, i As Long
shArr = Array("1st division", "2nd division", "3rd division")
For i = LBound(shArr) To UBound(shArr)
    With Sheets(shArr(i))
        With .PageSetup
            .PrintArea = "A1:N40"
            .Zoom = False
            .FitToPagesTall = 1
            .FitToPagesWide = 1
        End With
    .PrintOut
    End With
Next i
End Sub
 
Upvote 0
Hi. Try:
VBA Code:
Private Sub cbPrint_Click()
 ' Udskriver bestilling
 Dim ws As Worksheet
  For Each ws In Sheets(Array("1st division", "2nd division", "3rd division"))
   ws.PageSetup.PrintArea = "A1:N40"
   ws.PrintOut
  Next ws
End Sub
 
Upvote 0
VBA Code:
Sub Possibly()
Dim shArr, i As Long
shArr = Array("1st division", "2nd division", "3rd division")
For i = LBound(shArr) To UBound(shArr)
    With Sheets(shArr(i))
        With .PageSetup
            .PrintArea = "A1:N40"
            .Zoom = False
            .FitToPagesTall = 1
            .FitToPagesWide = 1
        End With
    .PrintOut
    End With
Next i
End Sub
VBA Code:
Sub Possibly()
Dim shArr, i As Long
shArr = Array("1st division", "2nd division", "3rd division")
For i = LBound(shArr) To UBound(shArr)
    With Sheets(shArr(i))
        With .PageSetup
            .PrintArea = "A1:N40"
            .Zoom = False
            .FitToPagesTall = 1
            .FitToPagesWide = 1
        End With
    .PrintOut
    End With
Next i
End Sub
Hi again, you code is very fine, but I got one problem. when I use this code and do not change this line shArr = Array ("1st division", "2nd division", "3rd division") where there are pictures in the sheets with pictures are printed out. But when I change the line to shArr = Array ("" 1. Shift "," 2. Shift "," 3. Shift "," F-division "," T-division ") and Excel should print the sheets with image, it prints but no pictures are included.Can you help?
 
Upvote 0
Hi

jolivanes again, I think the code it look like the code you sent me the first time. I am normeli using this code. But it only print 1 sheet.​

KW
VBA Code:
Sub Knap1_Klik()

'

' Udskriver liste

'

Range("A1:f24").Select

ActiveSheet.PageSetup.PrintArea = "A1:f24"

ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _

:=True

'

End Sub
 
Upvote 0
I don't understand what you're asking in Post #6 Klaus.
Are you not using the code supplied in Post #2?
Do the pictures print yet? If not, it must be a setting somewhere on your end of it.
Are the pictures formatted to be printed? (right click on picture, select properties and checkmark "print object" or something similar)
 
Upvote 0
Hi Jolivanes, I use the code from # 2. And it works, it prints the 3 sheets that are in the line shArr = Array ("1st division", "2nd division", "3rd division") with pictures and all text. I have 5 other sheets that are very similar to them, here I thought I could just change the names in line shArr = Array ("1st division", "2nd division", "3rd division") to shArr = Array ("1st shift", " 2. Shift "," 3. Shift "," F-division "," T-division "). And then it had to print pictures and all the text. But it only prints the text. I have so far used this code, it prints pictures and all text. But it only works on one sheet. Does it make sense. Best regards Klaus W
VBA Code:
Sub Knap2_Klik()
'
    ' Udskriver liste
    '
    Range("A1:N40").Select
    ActiveSheet.PageSetup.PrintArea = "A1:N40"
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True
'
End Sub
 
Upvote 0
What if you change this line
Code:
shArr = Array("1st division", "2nd division", "3rd division")
to this
Code:
shArr = Array("1st division", "2nd division", "3rd division", "1st shift", "2. Shift","3. Shift","F-division","T-division")
I deleted the spaces between the double quotation marks and the sheet names.

If this does not work, let us know and we'll change the code you used for a single sheet to work on multiple sheets.
Your code would look like so:
Code:
Sub Possibly_With_Extra_Sheets()
Dim shArr, i As Long
shArr = Array("1st division", "2nd division", "3rd division", "1st shift", "2. Shift","3. Shift","F-division","T-division")
For i = LBound(shArr) To UBound(shArr)
    With Sheets(shArr(i))
        With .PageSetup
            .PrintArea = "A1:N40"
            .Zoom = False
            .FitToPagesTall = 1
            .FitToPagesWide = 1
        End With
    .PrintOut
    End With
Next i
End Sub
 
Upvote 0
This is more or less the code you used for single sheet printing, changed for multiple sheets.
Code:
Sub Knap2_Klik()
Dim shArr, i As Long, a As String
shArr = Array("1st division", "2nd division", "3rd division", "1st shift", "2. Shift","3. Shift","F-division","T-division")
a = ActiveSheet.Name
Application.ScreenUpdating = False
    For i = LBound(shArr) To UBound(shArr)
        Sheets(shArr(i)).Select
            With ActiveSheet.PageSetup
                .PrintArea = "A1:N40"
                .Zoom = False
                .FitToPagesTall = 1
                .FitToPagesWide = 1
            End With
        ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True
    Next i
Sheets(a).Select
Application.ScreenUpdating = False
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,567
Messages
6,114,344
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top