HI excel_learner,
Welcome to ExcelFox!!
Try this. Untested.
HTHCode: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




Reply With Quote

Bookmarks