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

[recreated1]

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!!

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

 

[Fluff]

@recreated1
How about

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

 

[lesleyfayburton]

@lesleyfayburton
Please do not "hijack" another members thread. You need to start a thread of your own. Thanks.

Sorry about that

 

[lesleyfayburton]

@recreated1
How about

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.

 

[recreated1]

OK this works brilliantly! Thank you!!

 

[Fluff]

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]

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]

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

 

[recreated1]

The buttons appear on the sheet "Observations and Trends"
They are both Form Control buttons
Button names "Clear Form" and "Save Dealer File"

 

[Fluff]

Ok, how about

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

 

[recreated1]

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

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