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            '关闭文件

0

End Sub