Saving .xlsm worksheet as .xls workbook

[MalcolmGill]

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

 

[Fluff]

Looks fine to me
Although if you don't want the extra sheet(s) in the new workbook, you could use

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]

Hi welcome to forum

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

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

 

[MalcolmGill]

Thanks so much for your time and wisdom. Much appreciated.

 

[Fluff]

Glad we could help & thanks for the feedback