如何对比两个Workbook的Worksheet名称，跳过同名表并复制缺失表？

我来帮你调整代码，实现「只复制目标工作簿里没有的工作表」这个需求——你的全量复制逻辑没问题，只需要加一层工作表名称查重的判断就可以了。

实现思路 #

1. 先把目标工作簿（wbk1）的所有工作表名称存进一个集合，利用集合的Key属性快速判断名称是否存在
2. 遍历基准工作簿（wbk4）的每个工作表，检查目标工作簿里有没有同名的
3. 只有当目标工作簿没有这个工作表时，才执行复制操作

修改后的VBA代码 #

Sub CopyMissingWorksheets()
    Dim wbk1 As Workbook, wbk4 As Workbook
    Dim sh As Worksheet
    Dim sheetNames As Collection
    Dim targetPath As String
    
    ' 赋值目标工作簿（这里用ThisWorkbook代表当前运行代码的工作簿，可根据实际修改）
    Set wbk1 = ThisWorkbook ' 也可以写成Workbooks("你的目标工作簿名称.xlsx")
    
    ' 初始化集合，存储目标工作簿的工作表名称（统一转大写避免大小写敏感）
    Set sheetNames = New Collection
    On Error Resume Next ' 忽略重复添加的错误（工作表名称本身唯一，这里是保险操作）
    For Each sh In wbk1.Worksheets
        sheetNames.Add sh.Name, Key:=UCase(sh.Name)
    Next sh
    On Error GoTo 0 ' 恢复默认错误处理
    
    ' 拼接基准工作簿路径并打开
    targetPath = "G:\Financial\Facility Work Papers and Financials\8. Wage Reconcilliations\Wage Reconciliation 2017\December 2017 completed" & rngFacility & " " & WageRec & " " & TwelveThirtyOne & ".xls"
    Set wbk4 = Workbooks.Open(targetPath)
    
    ' 遍历基准工作簿，只复制缺失的工作表
    For Each sh In wbk4.Worksheets
        On Error Resume Next
        ' 尝试把当前工作表名称加入集合，重复的话会报错
        sheetNames.Add sh.Name, Key:=UCase(sh.Name)
        If Err.Number <> 0 Then
            ' 名称已存在，跳过当前工作表
            Err.Clear
        Else
            ' 名称不存在，复制到目标工作簿的最后
            sh.Copy After:=wbk1.Sheets(wbk1.Sheets.Count)
        End If
        On Error GoTo 0
    Next sh
    
    ' 可选：关闭基准工作簿（不需要保存的话设为False）
    wbk4.Close SaveChanges:=False
End Sub

关键细节说明 #

• 大小写兼容：用UCase()把工作表名称转成大写作为集合的键，避免因大小写差异（比如"Sheet1"和"SHEET1"）误判为不同工作表
• 高效查重：集合的Key属性自带唯一性校验，比逐个遍历工作表名称的效率更高
• 灵活调整：如果只需要复制可见工作表，可以在复制前加判断：If sh.Visible = xlVisible Then

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