VBA循环将主工作簿数据批量粘贴至多工作簿的卡滞问题解决

原代码核心错误 #

• 空对象调用：仅声明了WS工作表变量但未做任何赋值绑定，执行到WS.Name时触发空对象运行时错误，是卡滞的直接原因。
• 判断逻辑错误：WS.Name = WB.Sheets("FX Rates")属于类型不匹配判断，前者是字符串类型的工作表名，后者是工作表对象，逻辑永远不成立；且未做容错判断，若目标工作簿不存在FX Rates工作表，直接调用Sheets("FX Rates")会直接抛出下标越界错误。
• 对象引用不明确：复制操作使用Select/Selection的冗余写法，粘贴时的Range("A1")未指定所属工作表，会默认粘贴到当前激活的工作表，无法精准写入目标位置。
• 未匹配需求规则：未实现最多处理30个目标工作簿的限制，也未做运行优化和资源释放，批量操作时容易出现卡顿、剪贴板占用问题。

修复后可直接运行的代码 #

Sub Update_Files()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim Master As Workbook
    Dim processCount As Long
    
    ' 初始化配置，提升运行速度
    Set Master = ThisWorkbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    processCount = 0
    
    ' 直接复制源数据，无需选中区域
    Master.Sheets("FX").Range("A1:I148").Copy
    
    ' 遍历所有已打开的工作簿
    For Each WB In Application.Workbooks
        ' 跳过主工作簿，且不超过30个目标的处理上限
        If WB.Name <> Master.Name And processCount < 30 Then
            ' 遍历当前工作簿内的工作表，匹配目标表名
            For Each WS In WB.Worksheets
                If WS.Name = "FX Rates" Then
                    ' 精准粘贴值到目标表A1位置
                    WS.Range("A1").PasteSpecial Paste:=xlPasteValues
                    processCount = processCount + 1
                    Exit For
                End If
            Next WS
        End If
        ' 达到处理上限直接退出循环
        If processCount >= 30 Then Exit For
    Next WB
    
    ' 释放资源，恢复默认配置
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "操作完成，共更新" & processCount & "个工作簿的FX Rates表", vbInformation
End Sub

使用说明 #

运行代码前请确保所有需要更新的目标工作簿已经处于打开状态，若目标FX Rates工作表设置了工作表保护，请先取消保护后再执行代码，否则会触发粘贴失败错误。代码自动适配主工作簿文件名，不需要手动硬编码主文件名称。

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