如何修改VBA代码实现跨工作簿批量复制数据到目标工作簿现有工作表

你原来使用的Worksheet.Copy方法本质是复制整个工作表对象，因此会自动在目标工作簿中新建工作表，不符合匹配已有同名工作表粘贴值的需求，以下是适配后的代码：

Sub CopyWorkbookToExistingSheets()
    Dim srcSh As Worksheet
    Dim destWb As Workbook
    Dim destSh As Worksheet
    ' 绑定目标工作簿，请确保目标工作簿已提前打开，文件名匹配
    Set destWb = Workbooks("Destination.xlsm")
    
    ' 遍历源工作簿的所有工作表，请确保源工作簿已提前打开
    For Each srcSh In Workbooks("Origin.xlsm").Worksheets
        ' 匹配目标工作簿中同名的工作表
        On Error Resume Next
        Set destSh = destWb.Worksheets(srcSh.Name)
        On Error GoTo 0
        
        ' 如果找到同名目标工作表则执行复制粘贴
        If Not destSh Is Nothing Then
            ' 复制源工作表所有已使用单元格
            srcSh.UsedRange.Copy
            ' 粘贴值到目标工作表A1起始位置
            destSh.Range("A1").PasteSpecial Paste:=xlPasteValues
            ' 清除剪贴板
            Application.CutCopyMode = False
            ' 释放对象变量，方便下一次循环匹配
            Set destSh = Nothing
        End If
    Next srcSh
    MsgBox "数据同步完成"
End Sub

注意事项 #

• 运行代码前请确认Origin.xlsm和Destination.xlsm两个工作簿都已处于打开状态，文件名和后缀名需要和代码中完全一致
• 源工作表和目标工作表的名称必须完全匹配（包括大小写、空格等特殊字符），如果对应名称的工作表不存在，代码会自动跳过该表
• 上述代码默认仅粘贴单元格数值，如果你需要同步粘贴格式、公式、批注等内容，可以修改PasteSpecial的参数：
  • 粘贴数值+格式：destSh.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  • 粘贴全部内容：destSh.Range("A1").PasteSpecial Paste:=xlPasteAll
• 如果你需要在粘贴前清空目标工作表原有内容，可以在srcSh.UsedRange.Copy前加一行destSh.Cells.Clear

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