如何通过VBA批量为多个工作表S11-S13写入指定公式

以下是满足你需求的修改后VBA代码，已解决批量打开工作簿、动态选择第一个工作表、直接写入公式这三个核心要求：

Sub update_formulas()
    Dim i As Integer
    Dim targetPath As String
    Dim targetWb As Workbook
    Dim targetWs As Worksheet
    
    ' 获取存储在当前工作簿A3单元格的目标路径
    targetPath = ThisWorkbook.Range("A3").Value
    ' 确保路径末尾带有斜杠，避免拼接错误
    If Right(targetPath, 1) <> "\" Then targetPath = targetPath & "\"
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False ' 关闭屏幕刷新提升运行效率
    
    ' 遍历A2到C2指定的文件序号范围
    For i = ThisWorkbook.Range("A2").Value To ThisWorkbook.Range("C2").Value
        ' 打开目标工作簿（假设文件名是序号i对应的xlsm文件，规则不同可自行调整）
        Set targetWb = Workbooks.Open(targetPath & i & ".xlsm", UpdateLinks:=3)
        ' 动态获取当前工作簿的第一个工作表
        Set targetWs = targetWb.Sheets(1)
        
        ' 直接写入指定公式到对应单元格
        targetWs.Range("S11").Formula = "='https://cloud.sharepoint.com/Shared Documents/[New York.xlsx]SHEETNAME(1)'!$Y11"
        targetWs.Range("S12").Formula = "='https://cloud.sharepoint.com/Shared Documents/[New York.xlsx]SHEETNAME(1)'!$Y12"
        targetWs.Range("S13").Formula = "=SUM(S12:S13)"
        
        ' 保存并关闭工作簿
        targetWb.Save
        targetWb.Close
    Next i
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

关键修改说明： #

• 动态定位第一个工作表：用targetWb.Sheets(1)直接获取每个工作簿的首个工作表，替代原代码中固定的工作表名称，适配不同工作簿的表名差异。
• 直接写入公式：通过Range.Formula属性直接给单元格赋值公式，彻底摒弃粘贴操作，逻辑更清晰稳定。
• 修复路径拼接问题：原代码中未赋值的VarCellValue会导致文件打开失败，这里改用循环变量i拼接文件名（若你的文件名规则不同，可修改targetPath & i & ".xlsm"部分）。
• 优化运行体验：添加屏幕刷新关闭逻辑，减少代码运行时的界面卡顿，提升处理速度。
• 明确对象引用：用ThisWorkbook指定存放代码的工作簿，避免因激活其他文件导致的引用错误。

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