Hopefully I can explain this properly. I have a file that
I use to create quotes. I use this file as a template. I
have 3 macros, oneyear, twoyear and threeyear. The purpose
of each is to move and format information into my "email
template macro.xls" file. All of the macros work as long
as I don't change the original file name, which is "Macro
based quote template.xls". The problem is, when I have to
do a 2 or 3 year quote, I want to be able to enter my
information for year one and save it as a newfile name.
Then, I want to update the information for a 2 year quote,
save as a new file name and run the macro to add it to
my "email template macro.xls". And if I have a 3rd year to
quote, I want to be able to update the information and
save the file and run the threeyear macro to add that to
my "email template macro.xls". How do I setup each macro
so that no matter what its file name is, the macro will
run. Like I said, it will work as long as I don't change
the original files name "macro based quote template.xls"
See my macro for the one year to get an idea of how I have
the beginnig setup.

Application.ActivePrinter = "Microsoft Office Document
Image Writer on Ne00:"
ChDir _
"C:\Documents and Settings\bhodge\Application
Data\Microsoft\Office\Recent"
Workbooks.Open Filename:= _
"N:\Contract QuoteTemplates\Email Template
Macro.xls"
Windows("Macro based quote template-1.xls").Activate
Sheets("Quote Header").Select
Sheets("Quote Header").Copy Befo=Workbooks("Email
Template Macro.xls"). _
Sheets(1)
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Macro based quote template-1.xls").Activate
Sheets("Cover").Select
Sheets("Cover").Copy Befo=Workbooks("Email Template
Macro.xls").Sheets(2)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Macro based quote template-1.xls").Activate
Sheets("Agreement").Select
Sheets("Agreement").Copy Befo=Workbooks("Email
Template Macro.xls").Sheets _
(3)
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Sheets("Cover").Select
Cells.Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Sheets("Quote Header").Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Range("D12").Select
Sheets("Cover").Select
Sheets("Cover").Name = "1YR Cover"
Sheets("Agreement").Select
Sheets("Agreement").Name = "1YR Agreement"
Range("F23").Select
Sheets("Quote Header").Select
Range("D4").Select
Application.ScreenUpdating = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 90
Application.ScreenUpdating = True
End With
Sheets("1YR Cover").Select
Range("B8").Select
Application.ScreenUpdating = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 100
Application.ScreenUpdating = True
End With
Sheets("1YR Agreement").Select
Application.ScreenUpdating = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = 70
Application.ScreenUpdating = True
End With
Range("A1").Select
End Sub

Bhodge

I'd guess it's here


Windows("Macro based quote template-1.xls").Activate

If you want to activate the workbook that contains the code, you can use

ThisWorkbook.Activate

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Subscript out of Range" error occurs when you try to refer an arra
element or objects collaction that is not defined.
For example, you refer to myArr(15) when myArr is defined as
Dim myArr(10).

Here, may be you are trying to refer ActiveWorkbook.Sheets(3) wher
there are only 2 sheets.

So, check up all such statements in code

--
Message posted from http://www.ExcelForum.com