VBA多工作簿Do循环中断问题：调用模板后无法继续执行

核心问题 #

1. 依赖Select/Activate这类焦点操作，模板打开并关闭后，原工作簿的单元格上下文丢失，导致循环直接中断。
2. 代码逻辑顺序错误：打开模板后未等其完成Auto_Open宏的全流程（取数、另存、关闭），就强行切换回原工作簿执行删除，上下文混乱引发程序终止。

修复后的代码 #

Sub Scorecalculation2()
    Dim wbOriginal As Workbook
    Dim wsOriginal As Worksheet
    Dim templatePath As String
    
    ' 用对象变量固定引用原工作簿和工作表，彻底脱离对焦点的依赖
    Set wbOriginal = ThisWorkbook
    Set wsOriginal = wbOriginal.Worksheets("你的工作表名称") ' 替换为实际工作表名，比如"ISO代码列表"
    templatePath = "M:\RM\Country Risk\Data\MacroFiches\CRAM templates and critical values\RISK_score_OECD - CRAM_PROTOTYPEtest.xlsm"
    
    ' 循环终止条件：原工作表A2单元格为空
    Do Until IsEmpty(wsOriginal.Range("A2").Value)
        ' 打开模板，触发其Auto_Open宏
        Workbooks.Open Filename:=templatePath, UpdateLinks:=3
        
        ' 等待模板完成所有操作并关闭
        Do While Not Application.Workbooks("RISK_score_OECD - CRAM_PROTOTYPEtest.xlsm") Is Nothing
            DoEvents ' 释放CPU资源，等待模板进程结束
        Loop
        
        ' 在原工作表中删除第2行
        wsOriginal.Rows(2).EntireRow.Delete
    Loop
End Sub

关键改进点 #

• 抛弃焦点操作：用wbOriginal和wsOriginal直接绑定原工作簿和工作表，不管当前激活的是哪个文件，都能精准操作。
• 等待模板闭环：通过循环检测模板文件是否关闭，确保Auto_Open宏的取数、另存、关闭全流程完成后，再执行原工作簿的删除操作，避免上下文冲突。
• 稳定循环逻辑：直接检查原工作表A2单元格的值，删除行后下一次循环自动对应新的A2（原A3单元格），逻辑更可靠。

额外调整说明 #

如果模板的Auto_Open宏没有自动关闭模板，需要修改打开模板的代码段，手动触发关闭：

Dim wbTemplate As Workbook
Set wbTemplate = Workbooks.Open(Filename:=templatePath, UpdateLinks:=3)
' 等待Auto_Open宏执行（同步宏无需额外等待，异步场景需根据实际调整）
wbTemplate.Close SaveChanges:=True ' 按模板宏的另存逻辑调整SaveChanges参数

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