Exporting Worksheet to save to specific location

[scotthannaford1973]

Hi

I have the following code that saves an entire workbook to a specific folder and then adds the date and time to the file name. I am trying to amend it so that it only exports the current worksheet, saving it as .xlsx instead of .xlsm, not the entire worbook, but it does everything else that is shown. Would appreciate if someone can assist. TIA


Sub Auto_Save()
Dim savedate
savedate = Date
Dim savetime
savetime = Time
Dim formattime As String
formattime = Format(savetime, "hh.MM")
Dim formatdate As String
formatdate = Format(savedate, "YYYY.MM.DD")
Application.DisplayAlerts = False
Dim backupfolder As String
backupfolder = "M:\Acute\PMO\2018-19 CIP\0000. Archive\"
ActiveWorkbook.SaveCopyAs Filename:=backupfolder & formatdate & " " & formattime & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
MsgBox "CIP Tracker backed up to " & backupfolder & " - check folder if needed!"
End Sub

 

[mumps]

Try:

Sub Auto_Save()
    Dim savedate, savetime, formattime As String, formatdate As String, backupfolder As String, srcWB As Workbook
    savedate = Date
    savetime = Time
    formattime = Format(savetime, "hh.MM")
    formatdate = Format(savedate, "YYYY.MM.DD")
    Set srcWB = ThisWorkbook
    Application.DisplayAlerts = False
    backupfolder = "M:\Acute\PMO\2018-19 CIP\0000. Archive\"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=backupfolder & formatdate & " " & formattime & " " & srcWB.Name, FileFormat:=51
    Application.DisplayAlerts = True
    ActiveWorkbook.Close False
    MsgBox "CIP Tracker backed up to " & backupfolder & " - check folder if needed!"
End Sub

 

[scotthannaford1973]

Try:

Sub Auto_Save()
    Dim savedate, savetime, formattime As String, formatdate As String, backupfolder As String, srcWB As Workbook
    savedate = Date
    savetime = Time
    formattime = Format(savetime, "hh.MM")
    formatdate = Format(savedate, "YYYY.MM.DD")
    Set srcWB = ThisWorkbook
    Application.DisplayAlerts = False
    backupfolder = "M:\Acute\PMO\2018-19 CIP\0000. Archive\"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=backupfolder & formatdate & " " & formattime & " " & srcWB.Name, FileFormat:=51
    Application.DisplayAlerts = True
    ActiveWorkbook.Close False
    MsgBox "CIP Tracker backed up to " & backupfolder & " - check folder if needed!"
End Sub

Hi Mumps

thanks for that - unfortunately it flashes up an error when I run it - any ideas?

it doesn't like:
ActiveWorkbook.SaveAs Filename:=backupfolder & formatdate & " " & formattime & " " & srcWB.Name, FileFormat:=51



TIA

 

[mumps]

Try:

Sub Auto_Save()
    Dim savedate, savetime, formattime As String, formatdate As String, backupfolder As String, srcWB As Workbook
    savedate = Date
    savetime = Time
    formattime = Format(savetime, "hh.MM")
    formatdate = Format(savedate, "YYYY.MM.DD")
    Set srcWB = ThisWorkbook
    Application.DisplayAlerts = False
    backupfolder = "M:\Acute\PMO\2018-19 CIP\0000. Archive\"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=backupfolder & formatdate & " " & formattime & " " & Split(srcWB.Name, ".")(0) & ".xlsx", FileFormat:=51
    Application.DisplayAlerts = True
    ActiveWorkbook.Close False
    MsgBox "CIP Tracker backed up to " & backupfolder & " - check folder if needed!"
End Sub

 

[scotthannaford1973]

that's spot on - thanks, Mumps

 

[mumps]

You are very welcome.