Printing Sheets Based On Criteria VBA

[excel_learner]

I have following codes which prints the selected sheet within range in the workbook. Now, I want to be able to without deleting or disturbing the range, select the sheets which i want to print by marking them "x" in the next column. And other thing which i want to do is to be able to print some sheets from other workbook (as the workbook should be opened and selected sheet printed) but in same directory, if i specify the print range in the existing range of sheets which are to be printed.

Kindly advise.



Option Explicit
Sub Print_Ranges()
Dim strShtname As String, strRngName As String
Dim i As Long

With Worksheets("INDEX")

'sort the named range list according to page number order
.Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom

'loop through the cells and determine parent of named range and specific range addresses
For i = 3 To 34
strRngName = .Cells(i, 2).Text
strShtname = Range(strRngName).Parent.Name

'clear any existing print areas and reset to named ranges areas
With Worksheets(strShtname)
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = Range(strRngName).Address
.PrintOut
' .PrintPreview
End With
Next i
End With

End Sub

[Admin]

HI excel_learner,

Welcome to ExcelFox!!

Try this. Untested.


Option Explicit
Sub Print_Ranges()
Dim strShtname As String, strRngName As String
Dim i As Long

With Worksheets("INDEX")

'sort the named range list according to page number order
.Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom

'loop through the cells and determine parent of named range and specific range addresses
For i = 3 To 34
If LCase$(.Cells(i, "C").Text) = "x" Then 'I assume the 'X' is in Col C,if not, replace "C" with appropriate Col
strRngName = .Cells(i, 2).Text
strShtname = Range(strRngName).Parent.Name

'clear any existing print areas and reset to named ranges areas
With Worksheets(strShtname)
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = Range(strRngName).Address
.PrintOut
' .PrintPreview
End With
End If
Next i
End With

End Sub

'//This routine is for print sheets from other workbook

Sub PrintRangesFromOtherWorbook(ByVal WbkName As String, ParamArray Sheets2Print() As Variant)

'workbook name should be with the extension

Dim i As Long
Dim wbkOther As Workbook

With Application
.ScreenUpdating = 0
.EnableEvents = 0
.DisplayAlerts = 0
End With

On Error Resume Next
Set wbkOther = Workbooks(CStr(WbkName))
If Err.Number <> 0 Then
Err.Clear
Set wbkOther = Workbooks.Open(ThisWorkbook.Path & "\" & WbkName, 0)
If Err.Number <> 0 Then
MsgBox "Workbook '" & WbkName & "' not found in" & vbLf & ThisWorkbook.Path, vbInformation
Err.Clear
GoTo QuickExit
End If
End If

For i = LBound(Sheets2Print) To UBound(Sheets2Print)
'I hope print area is there in every sheet
With wbkOther.Worksheets(Sheets2Print(i))
.PrintOut
' .PrintPreview
End With
MsgBox Sheets2Print(i)
Next
QuickExit:
With Application
.ScreenUpdating = 1
.EnableEvents = 1
.DisplayAlerts = 1
End With
End Sub

'// Call the macro like..

Sub kTest()
PrintRangesFromOtherWorbook "OtherWorkbookName.xls", "Sheet1", "Sheet2", "Sheet3"
End Sub

HTH