VBA: Save Sheet as xlsx file in original folder and original filename.

chuckp2022

New Member
Joined
May 3, 2022
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Ok, I’m new to VBA and I’m really struggling with getting a macro to do what I want it to do.

I have a spreadsheet (Office 365) with macros enabled (xlsm)

There are 4 sheets in the spreadsheet. One of them is a planned maintenance checklist. When the work/checklist is completed, I’d like to click a button to save the sheet with the original filename as xlsx in the folder where the original file is located. It should only be the sheet that has the checklist on it. I have already placed a ‘button’ on the page to start the macro. Just can’t get the macro to do what I want.

This is what I’d like.
I’d like it to suppress warning about saving it as xlsx, over writing an original file. Basically just do it, don’t ask questions!!
Save as the original filename but as xlsx.
Save to the original folder of the file.
As a bonus, remove the button that starts the macro. Not that important though.

I have a cell that gets the filename and it’s in (N1)
Here is what’s in cell N1:
=MID(CELL("filename"),FIND("[",CELL("filename"))+1,FIND("]",CELL("filename"))-FIND("[",CELL("filename"))-6)

I’ve been trying to use that as the fname

I’ve found many possible solutions, but they don’t do everything, and I don’t know enough about VBA to correct any issues.

This one almost works but has the wrong filename and saves is as xls, not xlsx. It’s in the correct folder though. Found it on MrExcel along with others. Can't seem to find one that does what I want.

---------
Sub Test()

' Copy activesheet to the new workbook
ActiveSheet.Copy
MsgBox "This new workbook will be saved as MyWb.xls(x)"

'Save new workbook as MyWb.xls(x) into the folder where ThisWorkbook is stored
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\MyWb", xlWorkbookNormal
MsgBox "It is saved as " & ActiveWorkbook.FullName & vbLf & "Press OK to close it"

End Sub

---------

Any help would be appreciated.
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,513
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Here's an example. If you want the file name to come from cell N1, you need to specify which worksheet N1 is located on, and the value in N1 must be a legal filename with an ".xlsx" file extension.

VBA Code:
'Save ActiveSheet to new WB w/ macro-free format while keeping original file open
Sub SaveXLSX()
    Dim Folder As String, FileName As String, FilePath As String, SheetName As String
    Dim DestWB As Workbook
    
    Folder = ThisWorkbook.Path
    FileName = "MyNewWorkbook.xlsx"                   'name of new .xlsx workbook
    'FileName = ActiveSheet.Range("N1").Value          'name of new .xlsx found in cell N1
    
    FilePath = Folder & FileName
    
    SheetName = ActiveSheet.Name
    ActiveSheet.Copy
    Set DestWB = ActiveWorkbook
    
    Application.DisplayAlerts = False
    DestWB.SaveAs FileName:=FilePath, FileFormat:=xlOpenXMLWorkbook
    DestWB.Close False
    Application.DisplayAlerts = True
    
    MsgBox "Worksheet " & SheetName & " saved to new workbook:" & vbCr & FilePath, vbOKOnly Or vbInformation, Application.Name
End Sub

For future posts , you should try to use code tags like I did above when posting your code. It makes it easier to read.

 

chuckp2022

New Member
Joined
May 3, 2022
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Here's an example. If you want the file name to come from cell N1, you need to specify which worksheet N1 is located on, and the value in N1 must be a legal filename with an ".xlsx" file extension.

VBA Code:
'Save ActiveSheet to new WB w/ macro-free format while keeping original file open
Sub SaveXLSX()
    Dim Folder As String, FileName As String, FilePath As String, SheetName As String
    Dim DestWB As Workbook
   
    Folder = ThisWorkbook.Path
    FileName = "MyNewWorkbook.xlsx"                   'name of new .xlsx workbook
    'FileName = ActiveSheet.Range("N1").Value          'name of new .xlsx found in cell N1
   
    FilePath = Folder & FileName
   
    SheetName = ActiveSheet.Name
    ActiveSheet.Copy
    Set DestWB = ActiveWorkbook
   
    Application.DisplayAlerts = False
    DestWB.SaveAs FileName:=FilePath, FileFormat:=xlOpenXMLWorkbook
    DestWB.Close False
    Application.DisplayAlerts = True
   
    MsgBox "Worksheet " & SheetName & " saved to new workbook:" & vbCr & FilePath, vbOKOnly Or vbInformation, Application.Name
End Sub

For future posts , you should try to use code tags like I did above when posting your code. It makes it easier to read.

Thank you. I'll give this a try as soon as I get home.
 

chuckp2022

New Member
Joined
May 3, 2022
Messages
5
Office Version
  1. 365
Platform
  1. Windows

rlv01,​

Thank you very much. It almost works.
I unremarked the dynamic filename and remarked the static filename.
It’s saving the file to the directory just above where the file is.

i.e. File is located in:
C:\Users\myname\OneDrive\Planned Maint\XA\Vendor\Spreadsheets\file.xlsm

It’s creating the file in:
C:\Users\myname\OneDrive\Planned Maint\XA\Vendor

So the resulting filename is: Spreadsheetsfile.xlsx
The value in N1 = file.xlsx

I get the same results on either filename, static or dynamic.

Thoughts?
 

chuckp2022

New Member
Joined
May 3, 2022
Messages
5
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

rlv01,​

Thank you very much. It almost works.
I unremarked the dynamic filename and remarked the static filename.
It’s saving the file to the directory just above where the file is.

i.e. File is located in:
C:\Users\myname\OneDrive\Planned Maint\XA\Vendor\Spreadsheets\file.xlsm

It’s creating the file in:
C:\Users\myname\OneDrive\Planned Maint\XA\Vendor

So the resulting filename is: Spreadsheetsfile.xlsx
The value in N1 = file.xlsx

I get the same results on either filename, static or dynamic.

Thoughts?
I've been trying stuff.
I rearranged where the filename is and added the filepath to the spreadsheet.
The filename is in cell N3 and the filepath is in N4.
Can I use that somehow?
 

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,513
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

rlv01,​

Thank you very much. It almost works.
I unremarked the dynamic filename and remarked the static filename.
It’s saving the file to the directory just above where the file is.

i.e. File is located in:
C:\Users\myname\OneDrive\Planned Maint\XA\Vendor\Spreadsheets\file.xlsm

It’s creating the file in:
C:\Users\myname\OneDrive\Planned Maint\XA\Vendor

So the resulting filename is: Spreadsheetsfile.xlsx
The value in N1 = file.xlsx

I get the same results on either filename, static or dynamic.

Thoughts?


This one has some debug code to help you understand what folder ThisWorkbook is in and where the new file will be saved.
VBA Code:
'Save ActiveSheet to new WB w/ macro-free format while keeping original file open
Sub SaveXLSX()
    Dim Folder As String, FileName As String, FilePath As String, SheetName As String, Msg As String
    
    Dim DestWB As Workbook
    
    Folder = ThisWorkbook.Path
    If Folder = "" Then                               'case when workbook is new and unsaved
        Folder = CurDir$
    End If
    
    If Not Right(Folder, 1) = "\" Then
        Folder = Folder & "\"                         'add backslash if not present
    End If
    
    FileName = "MyNewWorkbook.xlsx"                   'name of new .xlsx workbook
    'FileName = ActiveSheet.Range("N1").Value         'name of new .xlsx found in cell N1
    
    FilePath = Folder & FileName
    
    SheetName = ActiveSheet.Name
    
    'Debug code. These lines can be deleted later, once you have the functionality you want.
      Msg = "Folder for " & ThisWorkbook.Name & " is" & vbCr & "'" & Folder & "'"
      Msg = Msg & vbCr & vbCr & "File name: " & FileName
      Msg = Msg & vbCr & vbCr & "New file to be created: " & vbCr & "'" & FilePath & "'"
      If MsgBox(Msg & vbCr & vbCr & "Proceed?", vbOKCancel Or vbQuestion, "Debug Information") = vbCancel Then
          Exit Sub
      End If
    'End debug
    
    ActiveSheet.Copy
    Set DestWB = ActiveWorkbook
    
    Application.DisplayAlerts = False
    DestWB.SaveAs FileName:=FilePath, FileFormat:=xlOpenXMLWorkbook
    DestWB.Close False
    Application.DisplayAlerts = True
    
    MsgBox "Worksheet " & SheetName & " saved to new workbook:" & vbCr & FilePath, vbOKOnly Or vbInformation, Application.Name
End Sub
 
Solution

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,513
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

I've been trying stuff.
I rearranged where the filename is and added the filepath to the spreadsheet.
The filename is in cell N3 and the filepath is in N4.
Can I use that somehow?



Yes, you can rearrange things to suit yourself. If you get the path from N4, it is up to you to be sure it contains a valid existing folder name or else you will get a runtime error.
VBA Code:
'Save ActiveSheet to new WB w/ macro-free format while keeping original file open
Sub SaveXLSX()
    Dim Folder As String, FileName As String, FilePath As String, SheetName As String, Msg As String
    
    Dim DestWB As Workbook
    
    'Folder = ThisWorkbook.Path
    Folder = Trim(ActiveSheet.Range("N4").Value)
       
    If Folder = "" Then                               'case when workbook is new and unsaved
        Folder = CurDir$
    End If
    
    If Not Right(Folder, 1) = "\" Then
        Folder = Folder & "\"                         'add backslash if not present
    End If
    
    'FileName = "MyNewWorkbook.xlsx"                   'name of new .xlsx workbook
    FileName = ActiveSheet.Range("N3").Value         'name of new .xlsx found in cell N3
    
    FilePath = Folder & FileName
    
    SheetName = ActiveSheet.Name
    
    'Debug code. These lines can be deleted later, once you have the functionality you want.
    Msg = "Folder for " & ThisWorkbook.Name & " is" & vbCr & "'" & Folder & "'"
    Msg = Msg & vbCr & vbCr & "File name: " & FileName
    Msg = Msg & vbCr & vbCr & "New file to be created: " & vbCr & "'" & FilePath & "'"
    If MsgBox(Msg & vbCr & vbCr & "Proceed?", vbOKCancel Or vbQuestion, "Debug Information") = vbCancel Then
        Exit Sub
    End If
    'End debug
    
    ActiveSheet.Copy
    Set DestWB = ActiveWorkbook
    
    Application.DisplayAlerts = False
    DestWB.SaveAs FileName:=FilePath, FileFormat:=xlOpenXMLWorkbook
    DestWB.Close False
    Application.DisplayAlerts = True
    
    MsgBox "Worksheet " & SheetName & " saved to new workbook:" & vbCr & FilePath, vbOKOnly Or vbInformation, Application.Name
End Sub
 

chuckp2022

New Member
Joined
May 3, 2022
Messages
5
Office Version
  1. 365
Platform
  1. Windows
This one has some debug code to help you understand what folder ThisWorkbook is in and where the new file will be saved.
VBA Code:
'Save ActiveSheet to new WB w/ macro-free format while keeping original file open
Sub SaveXLSX()
    Dim Folder As String, FileName As String, FilePath As String, SheetName As String, Msg As String
   
    Dim DestWB As Workbook
   
    Folder = ThisWorkbook.Path
    If Folder = "" Then                               'case when workbook is new and unsaved
        Folder = CurDir$
    End If
   
    If Not Right(Folder, 1) = "\" Then
        Folder = Folder & "\"                         'add backslash if not present
    End If
   
    FileName = "MyNewWorkbook.xlsx"                   'name of new .xlsx workbook
    'FileName = ActiveSheet.Range("N1").Value         'name of new .xlsx found in cell N1
   
    FilePath = Folder & FileName
   
    SheetName = ActiveSheet.Name
   
    'Debug code. These lines can be deleted later, once you have the functionality you want.
      Msg = "Folder for " & ThisWorkbook.Name & " is" & vbCr & "'" & Folder & "'"
      Msg = Msg & vbCr & vbCr & "File name: " & FileName
      Msg = Msg & vbCr & vbCr & "New file to be created: " & vbCr & "'" & FilePath & "'"
      If MsgBox(Msg & vbCr & vbCr & "Proceed?", vbOKCancel Or vbQuestion, "Debug Information") = vbCancel Then
          Exit Sub
      End If
    'End debug
   
    ActiveSheet.Copy
    Set DestWB = ActiveWorkbook
   
    Application.DisplayAlerts = False
    DestWB.SaveAs FileName:=FilePath, FileFormat:=xlOpenXMLWorkbook
    DestWB.Close False
    Application.DisplayAlerts = True
   
    MsgBox "Worksheet " & SheetName & " saved to new workbook:" & vbCr & FilePath, vbOKOnly Or vbInformation, Application.Name
End Sub
That's amazing. This code works perfectly. I've been working on this for 6 months (on & off).
Thank you sooo much.
Cheers.
 

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,513
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Glad I could help.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,514
Messages
5,854,176
Members
431,623
Latest member
ncorkren

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