VBA合并工作簿时如何指定复制工作表名称并覆盖已有同名表

现有可正常运行的VBA代码，功能为将指定文件夹下所有工作簿的Sheet1工作表复制合并到当前工作簿，运行无异常。
需要实现两项功能调整：

• 修改每个复制到当前工作簿的工作表的名称
• 复制时如果当前工作簿中已存在同名工作表，直接覆盖原有工作表

原有代码如下：

Sub CombineFilesInSheets()
     
    Dim Path            As String
    Dim FileName        As String
    Dim Wkb             As Workbook
    Dim WS              As Worksheet
     
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = "*The path*" 'Change as needed
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        Worksheets("Sheet1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)    
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
     
End Sub

核心调整逻辑：

1. 新增工作表重命名规则，默认使用源工作簿文件名（去掉后缀）作为新工作表名，可根据需求自定义
2. 每次执行复制操作前，遍历当前工作簿所有工作表，存在同名表时直接删除，提前关闭系统弹窗提示避免打断运行
3. 新增跳过当前宏所在工作簿的判断，避免自引用导致的运行错误

调整后可直接运行的完整代码：

Sub CombineFilesInSheets()
     
    Dim Path            As String
    Dim FileName        As String
    Dim Wkb             As Workbook
    Dim targetShtName   As String
    Dim sht             As Worksheet
     
    ' 关闭事件触发、屏幕更新、系统弹窗，提升运行效率避免提示打断
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 替换为你的目标文件夹实际路径，例："C:\Data\待合并表格"
    Path = "*替换为你的实际文件夹路径*"
    ' 匹配所有xls/xlsx/xlsm/xlsb格式Excel文件，若仅需匹配xls可改回"*.xls"
    FileName = Dir(Path & "\*.xls*", vbNormal)
    
    Do Until FileName = ""
        ' 跳过存放宏的当前工作簿，避免自循环打开
        If FileName <> ThisWorkbook.Name Then
            Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
            
            ' --------------------------
            ' 可在此自定义工作表命名规则
            ' 当前规则：取源文件名（不含后缀）作为表名
            targetShtName = Left(FileName, InStrRev(FileName, ".") - 1)
            ' --------------------------
            
            ' 遍历当前工作簿，存在同名表则直接删除
            For Each sht In ThisWorkbook.Sheets
                If sht.Name = targetShtName Then
                    sht.Delete
                    Exit For
                End If
            Next sht
            
            ' 复制源表到当前工作簿末尾并重命名
            Wkb.Worksheets("Sheet1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = targetShtName
            
            Wkb.Close SaveChanges:=False
        End If
        FileName = Dir()
    Loop
    
    ' 恢复Excel默认设置
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
     
End Sub

• 运行前先将代码中Path变量的取值替换为你存放待合并文件的实际文件夹路径
• 如果需要调整工作表命名规则，直接修改targetShtName的赋值语句即可，例如需要加固定前缀可写为targetShtName = "合并_" & Left(FileName, InStrRev(FileName, ".") - 1)
• 覆盖操作不可逆，正式运行前请做好原文件备份，避免数据丢失

内容的提问来源于stack exchange，提问作者Christoffer Tuxen Rosing