通过独立工作簿复制工作簿至新工作簿时遇类型不匹配错误

类型不匹配错误原因 #

你代码里的For Each sht In wb2.Sheets触发类型不匹配，核心原因是：

• Sheets集合包含工作表（Worksheet）、**图表工作表（Chart）**等多种对象类型
• 但你把sht声明为Worksheet类型，当原工作簿存在非工作表对象时，就会因类型不兼容报错

直接修复方法 #

两种方案任选其一：

方案1：遍历所有类型的表（保留图表等） #

把sht的声明从Dim sht As Worksheet改为Dim sht As Object，兼容所有表类型：

Dim sht As Object ' 替换原来的Dim sht As Worksheet
For Each sht In wb2.Sheets
    sht.Copy after:=wb1.Sheets(wb1.Sheets.Count)
Next sht

方案2：仅遍历工作表（忽略图表等） #

直接使用Worksheets集合代替Sheets，只处理工作表：

For Each sht In wb2.Worksheets ' 替换wb2.Sheets
    sht.Copy after:=wb1.Sheets(wb1.Sheets.Count)
Next sht

代码优化建议（避免其他潜在问题） #

除修复错误，还可优化代码稳定性：

• 避免依赖Activate/ActiveWorkbook，直接通过对象引用操作：

  ' 替换Sheets("File List").Activate和后续的Range操作
  Dim wsFileList As Worksheet
  Set wsFileList = ThisWorkbook.Sheets("File List") ' 明确指向代码所在工作簿
  LRow = wsFileList.Range("B" & wsFileList.Rows.Count).End(xlUp).Row ' 兼容高版本Excel行数
  
  ' 替换Set wb1 = ActiveWorkbook
  Set wb1 = TempWB ' 直接引用新建的临时工作簿
  

• 打开原工作簿后，操作完成记得关闭：

  wb2.Close SaveChanges:=False ' 关闭原工作簿，不保存更改
  

• 完善临时文件重命名逻辑：

  ' 在复制完成后执行
  wb1.Close SaveChanges:=True ' 保存临时工作簿
  Kill "C:\Test\" & OrigFN ' 删除原文件
  Name "C:\Test\Temp.xlsx" As "C:\Test\" & OrigFN ' 重命名临时文件为原文件名
  

完整优化后代码 #

Public OrigFN As String
Public TempWB As Workbook

Sub Duplicate_Workbooks()
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sht As Object ' 改为Object兼容所有表类型
    Dim wsFileList As Worksheet
    Dim LRow As Long, x As Long
    
    Set wsFileList = ThisWorkbook.Sheets("File List")
    LRow = wsFileList.Range("B" & wsFileList.Rows.Count).End(xlUp).Row
    
    For x = 2 To LRow ' 遍历B列所有待处理文件，替换原来的固定To 2
        OrigFN = wsFileList.Range("B" & x).Value
        ' 确保文件名带扩展名，避免打开失败
        If InStr(OrigFN, ".") = 0 Then OrigFN = OrigFN & ".xlsx" ' 根据实际文件类型调整
        
        ' 删除临时文件
        On Error Resume Next
        Kill "C:\Test\Temp.xlsx"
        On Error GoTo 0
        
        ' 创建临时工作簿
        Set TempWB = Workbooks.Add
        TempWB.SaveAs Filename:="C:\Test\Temp.xlsx"
        Set wb1 = TempWB
        
        ' 打开原工作簿
        Set wb2 = Workbooks.Open(Filename:="C:\Test\" & OrigFN)
        
        ' 复制所有表到临时工作簿
        For Each sht In wb2.Sheets
            sht.Copy after:=wb1.Sheets(wb1.Sheets.Count)
        Next sht
        
        ' 关闭原工作簿
        wb2.Close SaveChanges:=False
        
        ' 保存临时工作簿并替换原文件
        wb1.Close SaveChanges:=True
        Kill "C:\Test\" & OrigFN
        Name "C:\Test\Temp.xlsx" As "C:\Test\" & OrigFN
    Next x
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

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