Saving .xlsm worksheet as .xls workbook

MalcolmGill

New Member
Joined
Aug 9, 2019
Messages
7
Hi guys
I want to save a single worksheet from a .xlsm workbook to a new .xls workbook, overwriting any version already saved without alerts. I think what I've got is OK but I'd appreciate any words of wisdom from you.

Sub SaveAs(grpID As String)

Dim fName As String
Dim fPath As String
Dim newBook As Workbook

fPath = "C:\U3A Registers"
fName = grpID & " Register.xls"

Set newBook = Workbooks.Add

ThisWorkbook.Sheets("Proforma1").Copy Before:=newBook.Sheets(1)

Application.DisplayAlerts = False

newBook.SaveAs Filename:=fPath & "" & fName, FileFormat:=56

Application.DisplayAlerts = True


Workbooks(fName).Close
End Sub
 

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.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,518
Office Version
  1. 365
Platform
  1. Windows
Looks fine to me :)
Although if you don't want the extra sheet(s) in the new workbook, you could use
Code:
Sub SaveAs(grpID As String)

Dim fName As String
Dim fPath As String
Dim newBook As Workbook

fPath = "C:\U3A Registers"
fName = grpID & " Register.xls"


ThisWorkbook.Sheets("Proforma1").Copy

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs FileName:=fPath & "\" & fName, FileFormat:=56

Application.DisplayAlerts = True


Workbooks(fName).Close
End Sub
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,508
Office Version
  1. 2019
Platform
  1. Windows
Hi welcome to forum

At glance code looks ok but you could also add some error handling just in case things go wrong


Code:
Sub SaveAs(ByVal grpID As String)
    Dim fName As String, fPath As String
    Dim newBook As Workbook
    
    On Error GoTo myerror
    
    fPath = "C:\U3A Registers"
    fName = grpID & " Register.xls"
    
    With Application
        .DisplayAlerts = False: .ScreenUpdating = False
    End With
    
    If Not Dir(fPath, vbDirectory) = vbNullString Then
'copy sheet
        ThisWorkbook.Sheets("Proforma1").Copy
'set object variable to new workbook
        Set newBook = ActiveWorkbook
    
        newBook.SaveAs Filename:=fPath & "" & fName, FileFormat:=56
    Else
'path not found
        Err.Raise 76
    End If
    
myerror:
'close without saving
    If Not newBook Is Nothing Then newBook.Close False
    
    With Application
        .DisplayAlerts = True: .ScreenUpdating = True
    End With
'report errors
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,518
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,129,464
Messages
5,636,432
Members
416,918
Latest member
twc2c

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