Active Sheet

[Theo Degr]

Below is a Macro that I had written initially to just print the work sheets.
It has now evolved into not only printing but saving each work sheet as it's
own unique file. The issue that I am having is that I want to move this MACRO
to a main menu sheet. I know that if I do that the line of code for the
printing function will print the main menu page as opposed to the worksheet
page. could someone let me know what I need in order to fix the code.

Macro currently resides on Worksheet Page and I want it on the Main Menu Page.

See Macro below:

Sub Print_sheets_Click()
Dim position, max As Integer
Dim CurrentWorkbook As Workbook
Dim NewWorkbook As Workbook
Dim Rng As Range

'setting the print area
ActiveSheet.PageSetup.PrintArea = "$AB$2:$am$58"

'initialize beginning provider
position = Range("s3")

'get maximum number of providers from excel sheet
max = Range("t3")

MsgBox position & "------" & max

Do Until position > max 'check if max was reached yet

'change number sequentially in Cell n3
Range("n3") = position

'sending out put to the printer
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

' Saves Individual Provider Spreadsheets
Set CurrentWorkbook = ActiveWorkbook
Set NewWorkbook = Workbooks.Open(Filename:="Test.xls")
CurrentWorkbook.Sheets(Array("E-Mail Sheet")).Copy
after:=NewWorkbook.Worksheets(1)
Set Rng = Sheets("E-Mail Sheet").Range("g1")
ActiveWorkbook.SaveAs _
Filename:=Rng.Value & ".xls", _
FileFormat:=xlWorkbookNormal
NewWorkbook.Close SaveChanges:=True

'get next provider
position = position + 1

Loop

End Sub

 

[Tom Ogilvy]

Sub Print_sheets_Click()
Dim position, max As Integer
Dim CurrentWorkbook As Workbook
Dim NewWorkbook As Workbook
Dim Rng As Range
Dim sh as Worksheet

Set CurrentWorkbook = ActiveWorkbook
set sh = CurrentWorkbook.Sheets(Array("E-Mail Sheet"))
'setting the print area
sh.PageSetup.PrintArea = "$AB$2:$am$58"

'initialize beginning provider
position = sh.Range("s3")

'get maximum number of providers from excel sheet
max = sh.Range("t3")

MsgBox position & "------" & max

Do Until position > max 'check if max was reached yet

'change number sequentially in Cell n3
sh.Range("n3") = position

'sending out put to the printer
sh.PrintOut Copies:=1, Collate:=True

' Saves Individual Provider Spreadsheets

Set NewWorkbook = Workbooks.Open(Filename:="Test.xls")
sh.Copy after:=NewWorkbook.Worksheets(1)
Set Rng = Sheets("E-Mail Sheet").Range("g1")
ActiveWorkbook.SaveAs _
Filename:=Rng.Value & ".xls", _
FileFormat:=xlWorkbookNormal
NewWorkbook.Close SaveChanges:=True

'get next provider
position = position + 1

Loop

End Sub

 

[steve_doc]

declare a worksheet variable and set it to the desired worksheet

eg.
Dim Cwb as Workbook
Dim ws as Worksheet

Set Cwb = ThisWorkbook
Set ws = Cwb.Worksheets("YourWorksheetName")

ws.PageSetup.PrintArea = "your print area"

HTH