VBA实现无提示自动重命名保存单个工作表（避免覆盖）

针对你的需求，修正后的代码会优先保存无编号文件，若同名文件已存在则自动递增编号（(1)、(2)...），全程无覆盖提示，且仅保存指定工作表：

Dim wsDemo As Worksheet, i As Long, baseFileName As String
Dim saveDir As String, fullPath As String

' 保存目录
saveDir = "C:\Users\Dio\Documents\Working Files\"
' 确保目录末尾带斜杠，避免路径拼接错误
If Right(saveDir, 1) <> "\" Then saveDir = saveDir & "\"

' 定位要导出的工作表
Set wsDemo = ThisWorkbook.Worksheets("Demo")

' 基础文件名（不含增量编号）
baseFileName = "Popcorn Demo " & Format(Date, "mm-dd-yyyy")

' 关闭Excel覆盖提示弹窗
Application.DisplayAlerts = False

' 先检查无编号文件是否存在
fullPath = saveDir & baseFileName & ".csv"
If Len(Dir(fullPath)) = 0 Then
    wsDemo.SaveAs fullPath, FileFormat:=xlCSV
Else
    ' 若存在，从(1)开始循环查找可用文件名
    i = 1
    Do
        fullPath = saveDir & baseFileName & "(" & i & ")" & ".csv"
        i = i + 1
    Loop Until Len(Dir(fullPath)) = 0
    wsDemo.SaveAs fullPath, FileFormat:=xlCSV
End If

' 恢复Excel提示设置
Application.DisplayAlerts = True

关键修正点说明： #

• 无覆盖提示：通过Application.DisplayAlerts = False彻底禁用覆盖确认弹窗，实现全自动保存
• 优先无编号逻辑：先尝试保存基础文件名，避免不必要的编号
• 动态增量检查：用Do...Loop替代固定次数循环，支持无限递增编号（直到系统文件名长度上限）
• 路径容错处理：自动补全目录末尾斜杠，避免路径拼接错误
• 简化工作表定位：用ThisWorkbook直接引用当前工作簿，比原代码的FileSystemObject方式更简洁可靠

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