Saving .xlsm worksheet as .xls workbook

MalcolmGill

New Member
Joined
Aug 9, 2019
Messages
12
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

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
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
 
Upvote 0
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
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

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