VBA实现工作表另存为指定路径工作簿、删空表、覆盖文件、加日期问题

核心优化点对应你的两个需求： #

• 直接调用单工作表Copy方法自动生成仅含目标工作表的新工作簿，从根源避免出现默认空白Sheet1
• 临时关闭Excel系统告警实现静默删除/自动覆盖同名文件，操作后自动恢复告警避免影响后续使用
• 内置日期格式化函数直接拼接当日日期到文件名

完整可用代码 #

通用封装版（消除saveFile1、saveFile2重复代码） #

' 通用方法：传入工作表序号、文件名前缀，自动保存为独立工作簿
Private Sub SaveSheetAsWorkbook(sheetIndex As Integer, fileNamePrefix As String)
    Dim PathToSave As String
    ' 临时关闭所有告警提示
    Application.DisplayAlerts = False
    
    ' 拼接完整保存路径：路径+前缀+当日日期+后缀
    PathToSave = "C:\the path\" & fileNamePrefix & "_" & Format(Date, "yyyy-mm-dd") & ".xlsm"
    
    ' 复制目标工作表自动生成新工作簿，无默认空白表
    ThisWorkbook.Sheets(sheetIndex).Copy
    ' 自动覆盖同名文件保存
    ActiveWorkbook.SaveAs Filename:=PathToSave, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    ActiveWorkbook.Close SaveChanges:=False
    
    ' 必须恢复告警，否则后续Excel操作不会弹出任何提示
    Application.DisplayAlerts = True
End Sub

' 保存Sheet4调用入口
Sub saveFile1()
    ' 第二个参数可自定义Sheet4对应的文件名前缀
    Call SaveSheetAsWorkbook(4, "Sheet4业务表")
End Sub

' 保存Sheet5调用入口
Sub saveFile2()
    ' 第二个参数可自定义Sheet5对应的文件名前缀
    Call SaveSheetAsWorkbook(5, "Sheet5统计表")
End Sub

兼容你原有新建工作簿写法的静默删Sheet1方案 #

如果你需要保留原有新建工作簿的逻辑，使用以下代码即可静默删除默认Sheet1：

Sub newWorkbook()
    Dim wb As Workbook
    Set wb = Workbooks.Add
    Application.DisplayAlerts = False
    
    ThisWorkbook.Sheets(4).Copy Before:=wb.Sheets(1)
    ' 直接删除自带的Sheet1无弹窗
    wb.Sheets("Sheet1").Delete
    
    Application.DisplayAlerts = True
    wb.SaveAs "C:\the path and file"
End Sub

可调整配置说明 #

• 日期格式可按需修改：如需精确到时分秒，将Format(Date, "yyyy-mm-dd")替换为Format(Now(), "yyyy-mm-dd_hhmmss")
• 文件名前缀可自由调整：调用通用方法时修改第二个参数即可
• 保存路径修改：替换C:\the path\为你的实际存储路径，注意末尾保留反斜杠\

内容的提问来源于stack exchange，提问作者user14345147