Save Original Workbook as another name but keep original

gottimd

Well-known Member
Joined
Jul 29, 2002
Messages
501
My macro opens a template, recalculates based on what was selected from drop down menu. Then it saves the recalculated workbook as another name. But when it does this, it closes the template, meaning the template is renamed. Is there a way to keep the template open with the original name, while saving the recalculated workbook as something else?

The reason I ask is because I have a loop running off the template, but if it closes, it seems like the loop doesn't continue.
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Zack Barresse

MrExcel MVP
Joined
Dec 9, 2003
Messages
10,881
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
  3. Web
if your going to run the macro from the template, maybe something like this...

Dim fname As String
fname = ActiveWorkbook.Name


'a prompt for a new file name of your choice...
Dim newFile As String
newFile = InputBox(Prompt:="What would you like your file name to be?")
If newFile = Empty Then
MsgBox Prompt:="You must enter a valid file name."
Else
MsgBox Prompt:="Your new report file will be named " & newFile & ".xls"
End If


'save new file as your selection, from earlier...
ChDir _
"C:\your\file\folder\location"
ActiveWorkbook.SaveAs Filename:= _
newFile _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


'will close first workbook
Windows(fname).Activate
ActiveWindow.Close False


code generously helped by Pennysaver :)

HTH
 

gottimd

Well-known Member
Joined
Jul 29, 2002
Messages
501
Tried to incorporate into my code but it is stuck at the "windows(fname).Activate" part

Code:
    Dim newfile As String
    Dim template As String
    Dim wbx As Workbook
    Dim wby As Workbook
    Dim Month As String
    Dim Entity
    Dim underscore
    Dim Hypname
    Dim Fullnme
    Dim Mnth
    Dim Year
    Dim Consolidation
    Dim Response As Integer
    Dim Snd
    Dim Flder
    Dim dte
    Dim rsp
    Dim ws As Worksheet
    Dim I As Integer
    Dim x As Long
    Dim r As Long
    Dim sh As Worksheet
    r = 1

     
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    template = ActiveWorkbook.Name
    'Change name of drop down to suit
    
        With Worksheets("Data").DropDowns("Drop Down 17")
        For x = 1 To .ListCount
            .ListIndex = x
   
            'calculates and refreshes open workbook
    
   
             Sheets("TITLEPAGE").Activate
             ActiveSheet.Calculate
             Sheets("Data").Activate
             ActiveSheet.Calculate
             Sheets("Companies").Select
             ActiveWindow.ScrollWorkbookTabs Position:=xlLast
             Sheets(Array("Companies", "TITLEPAGE", "Data", "Assets", "Liabilities_Equity", _
                "Income_Statement", "Intercompany", "Inventory", "PPE-MONTH", "Intangibles", _
                "Headcount", "Debt", "Debt Worksheet", "Bonus", "Statistics", "Check")).Select
             Calculate
    
             'sets open workbook hyperion name and saves into send file
    
             Mnth = Sheets("TITLEPAGE").Range("a52")
             Year = Sheets("TITLEPAGE").Range("a53")
             Consolidation = Sheets("TITLEPAGE").Range("a54")
             Fldr = Sheets("TITLEPAGE").Range("a58")
             Month = Mnth & " " & Year & " " & Consolidation
             Entity = Sheets("TITLEPAGE").Range("A55")
             underscore = Sheets("TITLEPAGE").Range("A56")
             Hypname = Sheets("TITLEPAGE").Range("A57")
             Snd = Sheets("TITLEPAGE").Range("a58")
             dte = Sheets("TITLEPAGE").Range("a59")
             
             Fullnme = Entity & underscore & Hypname & Snd & underscore & dte
             newfile = Fullnme
                      
             Set wbx = ActiveWorkbook
             ActiveWorkbook.Saveas Filename:="E:\Groups\Hyperion\Acterna\Corp\FY2004\" & Month & "\Packs to load\Send\" & Fullnme & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
             ReadOnlyRecommended:=False, CreateBackup:=False
             
             Windows(template).Activate
             ActiveWindow.Close False

                           
         
            'Formats and copy and paste values so enduser can see values instead of Hyperion links
        
             Sheets("TITLEPAGE").Visible = False
             Sheets("Assets").Select
             Range("D13:D124").Select
             Selection.Copy
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
             Sheets("Liabilities_Equity").Select
             Range("D12:D93").Select
             Application.CutCopyMode = False
             Selection.Copy
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
             Sheets("Income_Statement").Select
             Range("D12:D140").Select
             Application.CutCopyMode = False
             Selection.Copy
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
             Sheets("Statistics").Select
             Range("D17:D20").Select
             Application.CutCopyMode = False
             Selection.Copy
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
             Range("D22:D27").Select
             Application.CutCopyMode = False
             Selection.Copy
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
             Range("D33").Select
             Range("D33:D35").Select
             Application.CutCopyMode = False
             Selection.Copy
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
             Range("D39:D41").Select
             Application.CutCopyMode = False
             Selection.Copy
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                 :=False, Transpose:=False
             ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
             Sheets("Data").Select
       
             'Protects all sheets so user cannot alter
    
              rsp = Sheets("Data").Range("B112").Value
    
              For I = 1 To Worksheets.Count
                      Application.ScreenUpdating = False
                      Worksheets(I).Protect rsp
                      Sheets("Data").Select
                      Sheets("data").unprotect rsp
                      Rows("111:117").Select
                      Selection.FormulaHidden = True
                      Selection.EntireRow.Hidden = True
                      Selection.Locked = True
                      Sheets("data").Protect rsp
                
              Next
       
              'formats inventory page so end user can enter data
    
              Sheets("Inventory").Select
              Sheets("Inventory").unprotect rsp
              Sheets("Inventory").Select
              ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                  False, AllowUsingPivotTables:=True
              Sheets("Data").Select
              Range("B2").Select
        
              'Saves active workbook to be sent and opens up template to start for new entity and closes finished template
        
              ActiveWorkbook.Save
              Set wby = Workbooks.Open("E:\Groups\Hyperion\Acterna\Corp\FY2004\" & Month & "\Entity Pack Template.xls")
              wbx.Close
            r = r + 1
        Next x
    
       Application.ScreenUpdating = True
       Application.DisplayAlerts = True
    
    End With
    
End Sub
 

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
723
This will keep it open as the original name. Question is what happens to the template when user is finished? Are the changes to be saved?

Code:
Sub savecopy()
    Dim fName
    fName = Application.GetSaveAsFilename
    If InStr(1, UCase(fName), UCase(ThisWorkbook.Name)) Then
        MsgBox "Sorry, you may not save as the existing name."
        Exit Sub
    End If
    ThisWorkbook.SaveCopyAs (fName)
End Sub
 

shanzek

New Member
Joined
Feb 23, 2004
Messages
19
I'm interested in the same concept, and have a problem with the code posted by firefytr.

I have a template (review_template.xlt) that has two worksheets: one has a list of employees to review, the second has the review form.
The functionality I'm trying to achieve is that the manager will select an employee from the list box (let's say 'bob') on the first worksheet. THe vba code will fill in the employees name ('bob') on the second sheet and change focus to the second sheet. THe manager will then fill in their scores. At the bottom of the second sheet is a button. That button prints the worksheet (that works fine); then it should save it as a new spreadsheet using the employees name as part of the worksheet name (this part works fine: review_bob.xls); but now the sheet that is loaded is 'review_bob.xls', not 'review_template.xlt'. Ideally it would save as 'review_bob.xls', close 'review_bob.xls', and either keep 'review_template.xlt' open or reopen it if need be. Then the manager can select another poor schmuck to review.

Seems that the windows(fname).active wants a numeric index, not a string name?

Thanks
Steve
 

Watch MrExcel Video

Forum statistics

Threads
1,123,318
Messages
5,600,925
Members
414,416
Latest member
Nobu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top