Excel VBA之工作表复制新增另存为新工作薄

Sub 另存为()

Set sht = Sheet4

Set mf = Sheet1

NewFileName = sht.Range("AE4") & "销售订单录入" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) '拟拟取名

On Error Resume Next

' ###########检查C盘下有没有此文件 #############

Dim ObjFSO

Set ObjFSO = CreateObject("Scripting.FileSystemObject")

If ObjFSO.FileExists("C:\" & NewFileName & ".xls") Then

MsgBox "C盘下已有此文件名，请重新命名！"

GoTo 0

End If

' ###########如果没有此文件则复制新增 #############

mf.Copy '复制工作表

ActiveWorkbook.SaveAs Filename:="C:\" & NewFileName & ".xls" '保存新增的文件并重命名到C盘下

ActiveWorkbook.Close True '关闭文件

End Sub