Archive of Mr Excel Message Board

Select sheets to print 1st then run code
Code is not mine
Sub MultiSheetPrint()
' prints the selected area on each of a set of selected worksheets on
' a single sheet
Dim oActive As Object
Dim oSheet As Object
Dim oSheets As Object
Dim wsPrint As Worksheet
Dim oLastPic As Object
Dim iPics As Integer
' remember where we are
Set oSheets = ActiveWindow.SelectedSheets
If oSheets.Count = 1 Then
Selection.PrintOut preview:=True
Exit Sub
End If
Set oActive = ActiveSheet
Application.ScreenUpdating = False
oActive.Select ' otherwise we get lots of new sheets
Set wsPrint = Worksheets.Add
For Each oSheet In oSheets
If TypeName(oSheet) = "Worksheet" Then
iPics = iPics + 1
oSheet.Activate
Selection.CopyPicture
wsPrint.Cells(iPics * 3 - 2, 1).Value = oSheet.Name
wsPrint.Paste wsPrint.Cells(iPics * 3 - 1, 1)
wsPrint.Rows(iPics * 3 - 1).RowHeight = _
wsPrint.Pictures(iPics).Height
End If
Next
wsPrint.PrintOut preview:=True
Application.DisplayAlerts = False
wsPrint.Delete
Application.DisplayAlerts = True
oSheets.Select
oActive.Activate
Application.ScreenUpdating = True
End Sub
HTH
Ivan
