如何修改VBA宏实现仅当相邻单元格H等于指定文本时生成模板工作簿

没问题，我来帮你调整这段VBA代码，让它只在**对应H列单元格的值等于TEST-NEW-INST-01**的时候才创建新工作簿。

核心思路很简单：在遍历I列单元格的循环里，增加一个条件判断，检查当前I列单元格左侧的H列单元格值是否符合要求。如果符合，才执行后续的复制、保存操作。

下面是修改后的完整代码，我标注了关键的修改部分：

Sub ONE_CreateTestsheetWB_TEST_NEW_INST_01()
    Application.DisplayAlerts = False
    Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range, c As Range
    Set sh1 = Sheets("MC_TestSheetGenerator") 'Edit sheet name
    lr = sh1.Cells(Rows.Count, "I").End(xlUp).Row
    Set rng = sh1.Range("I3:I" & lr)
    
    For Each c In rng
        ' 新增条件判断：检查相邻H列的值是否匹配
        If c.Offset(0, -1).Value = "TEST-NEW-INST-01" Then
            Sheets("TEST-NEW-INST-01").Copy 'Edit sheet name
            Set wb = ActiveWorkbook
            wb.Sheets(1).Range("A3") = c.Value
            wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ".xlsx", 51
            wb.Close False
        End If
    Next c
    
    Application.DisplayAlerts = True ' 移到循环外，确保最后恢复提示
End Sub

关键细节说明： #

• c.Offset(0, -1)：代表当前I列单元格c向左偏移1列的单元格（也就是同一行的H列单元格），我们通过这个来获取需要判断的值
• 把Application.DisplayAlerts = True移到循环外部，避免每次循环都重复设置，确保代码执行完毕后一定恢复系统提示
• 如果你的H列值可能存在大小写不一致的情况（比如test-new-inst-01），可以把判断改成不区分大小写的版本：

  If UCase(c.Offset(0, -1).Value) = UCase("TEST-NEW-INST-01") Then
  

这样修改后，代码就只会处理H列值为TEST-NEW-INST-01的行，也就是你说的第3行和第8行，生成对应的两个工作簿啦。

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