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:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,269
Office Version
  1. 365
Platform
  1. Windows
@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
 

Some videos you may like

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

lesleyfayburton

New Member
Joined
Dec 4, 2020
Messages
8
Office Version
  1. 2016
@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.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,269
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
 

recreated1

New Member
Joined
Dec 3, 2004
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
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?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,269
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

What is the name of the sheet & the name of the buttons?
Also are they ActiveX Buttons, Form Control or shapes?
 

recreated1

New Member
Joined
Dec 3, 2004
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
The buttons appear on the sheet "Observations and Trends"
They are both Form Control buttons
Button names "Clear Form" and "Save Dealer File"
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,269
Office Version
  1. 365
Platform
  1. Windows
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
 
Solution

recreated1

New Member
Joined
Dec 3, 2004
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
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:

Watch MrExcel Video

Forum statistics

Threads
1,123,242
Messages
5,600,506
Members
414,385
Latest member
Lioness227

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