vba to save as new workbook in current path using cell value as the new file name

recreated1

New Member
Joined
Dec 3, 2004
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
Hi,
I am a bit of a novice and have been trying to piece together a macro using code posted in the forum.
I am using Excel 2016
I am trying to create a save button that will save a new copy of the open workbook in the same directory path as the original, using the value in the first worksheet, Cell B2, as the new file name.
I have the following code but get a runtime error 1004 [Method 'SaveAs' of object'_Workbook' failed] on the red highlighted line.
Additionally, the original document contains the Macro so its an .xlsm format, and in the new document I want to disable the macro so saving as an .xlsx format
Can someone help me figure this out?
Thanks!!

Rich (BB code):
Sub SaveAsNewFile()


    Dim relativePath As String, sname As String
    sname = ActiveWorkbook.Worksheets(Sheet1).Range("B2") & ".xlsx"
    relativePath = Application.ActiveWorkbook.Path & "\" & sname
    Application.DisplayAlerts = False
    ActiveWorkbook.CheckCompatibility = False
    ActiveWorkbook.SaveAs FileName:=relativePath, FileFormat:=51
    Application.DisplayAlerts = True
End Sub
 
Last edited by a moderator:
@recreated1
How about
VBA Code:
Sub SaveAsNewFile()


Dim relativePath As String, sname As String, Thiswbk As String
Thiswbk = ThisWorkbook.FullName
sname = ActiveWorkbook.Worksheets("Observations and Trends").Range("B2") & ".xlsx"
relativePath = Application.ActiveWorkbook.Path & "\" & sname
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs FileName:=relativePath, FileFormat:=51
Application.DisplayAlerts = True
Workbooks.Open Thiswbk
Workbooks(sname).Close False
End Sub
 
Upvote 0

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
@recreated1
How about
VBA Code:
Sub SaveAsNewFile()


Dim relativePath As String, sname As String, Thiswbk As String
Thiswbk = ThisWorkbook.FullName
sname = ActiveWorkbook.Worksheets("Observations and Trends").Range("B2") & ".xlsx"
relativePath = Application.ActiveWorkbook.Path & "\" & sname
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs FileName:=relativePath, FileFormat:=51
Application.DisplayAlerts = True
Workbooks.Open Thiswbk
Workbooks(sname).Close False
End Sub
Thank you! and I don't want to waste your time, just trying to also learn as I go. I will be reading a lot after I get these sorted.
 
Upvote 0
You're welcome & thanks for the feedback.

When "marking as solution" please select the post that has the solution & not your post saying it works. I have changed it for you this time. Thanks
 
Upvote 0
OK will do in the future.
One last question (I promise) There are two Command Buttons on top of the Template.
Since the macros are now disabled on the newly saved .xlsx files, is it possible for the two buttons that launch the macros to be deleted before saving the new file so they don't confuse the users when the open those files and try to click on those buttons?
 
Upvote 0
What is the name of the sheet & the name of the buttons?
Also are they ActiveX Buttons, Form Control or shapes?
 
Upvote 0
The buttons appear on the sheet "Observations and Trends"
They are both Form Control buttons
Button names "Clear Form" and "Save Dealer File"
 
Upvote 0
Ok, how about
VBA Code:
Sub SaveAsNewFile()


Dim relativePath As String, sname As String, Thiswbk As String
Thiswbk = ThisWorkbook.FullName
With ActiveWorkbook.Worksheets("Observations and Trends")
   sname = .Range("B2") & ".xlsx"
   .Shapes("Save Dealer File").Delete
   .Shapes("Clear Form").Delete
End With
relativePath = Application.ActiveWorkbook.Path & "\" & sname
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs FileName:=relativePath, FileFormat:=51
Application.DisplayAlerts = True
Workbooks.Open Thiswbk
Workbooks(sname).Close False
End Sub
 
Upvote 0
Solution
Wow that is excellent.
I had to make a couple of changes because it wasn't finding the shapes and also added one more step before saving (there was data on tab 3 that was pulled in by a lookup formula that I wanted to replace with the values only). Below is the final VBA.
This is perfect!
Thanks so much

VBA Code:
Sub SaveAsNewFile()


Dim relativePath As String, sname As String, Thiswbk As String
Thiswbk = ThisWorkbook.FullName
With ActiveWorkbook.Worksheets("Observations and Trends")
   sname = .Range("B2") & ".xlsx"
   .Range("B4:K9").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B4").Select
    Sheets("Observations and Trends").Select
    ActiveSheet.Shapes.Range(Array("Button 2")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.Delete
    
End With
relativePath = Application.ActiveWorkbook.Path & "\" & sname
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs FileName:=relativePath, FileFormat:=51
Application.DisplayAlerts = True
Workbooks.Open Thiswbk
Workbooks(sname).Close False
End Sub
 
Last edited by a moderator:
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,998
Members
448,541
Latest member
iparraguirre89

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
Back
Top