如何让Worksheet_Change宏在工作簿所有工作表生效？

问题背景 #

我有一个包含Outstanding和Complete两个工作表的Excel工作簿，需要实现以下功能：

• 在Outstanding工作表中，将Z列单元格修改为“Complete”时，自动把当前行移动到Complete工作表
• 在Complete工作表中，将Z列单元格修改为“Outstanding”时，自动把当前行移动到Outstanding工作表

之前的代码在单个工作表的VBA模块中能正常运行，但放到工作簿模块后无法生效，且不想在两个工作表中重复编写相同的Worksheet_Change宏，需要一个通用的工作簿级解决方案。

原单个工作表可用代码：

'Remove Case Sensitivity
  Option Compare Text
Sub Worksheet_Change(ByVal Target As Range)
   ' On Error Resume Next - I took this out of this code that I found on the internet because it apparently causes problems
    
    Application.EnableEvents = False
    
        'If Cell that is edited is in column Z and the value is Complete then
    If Target.Column = 26 And Target.Cells(1).Value = "Complete" Then
        'Define last row on Complete worksheet to know where to place the row of data
        LrowCompleted = Sheets("Complete").Cells(Rows.Count, "A").End(xlUp).Row
        'Copy and paste data
        Range("A" & Target.Row & ":Z" & Target.Row).Copy Sheets("Complete").Range("A" & LrowCompleted + 1)
        'Delete Row from the ActiveSheet
        Range("A" & Target.Row & ":Z" & Target.Row).Delete xlShiftUp
     ElseIf Target.Column = 26 And Target.Cells(1).Value = "Outstanding" Then
        'Define last row on Outstanding worksheet to know where to place the row of data
        LrowCompleted = Sheets("Outstanding").Cells(Rows.Count, "A").End(xlUp).Row
        'Copy and paste data
        Range("A" & Target.Row & ":Z" & Target.Row).Copy Sheets("Outstanding").Range("A" & LrowCompleted + 1)
        'Delete Row from the ActiveSheet
        Range("A" & Target.Row & ":Z" & Target.Row).Delete xlShiftUp

   End If
     
    Application.EnableEvents = True
End Sub

解决方案 #

工作簿级代码实现 #

1. 按Alt + F11打开VBA编辑器
2. 双击左侧导航栏的ThisWorkbook模块，进入代码编辑界面
3. 粘贴以下代码：

' 取消大小写区分
Option Compare Text

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' 仅处理指定的两个工作表
    If Sh.Name <> "Outstanding" And Sh.Name <> "Complete" Then Exit Sub
    
    ' 仅处理Z列的单个单元格修改
    If Target.Column <> 26 Or Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    
    Dim targetSheet As Worksheet
    Dim sourceRow As Range
    Set sourceRow = Sh.Range("A" & Target.Row & ":Z" & Target.Row)
    
    Select Case Target.Value
        Case "Complete"
            ' 只有在Outstanding表修改为Complete时才执行移动
            If Sh.Name = "Outstanding" Then
                Set targetSheet = ThisWorkbook.Sheets("Complete")
                sourceRow.Copy targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Offset(1)
                sourceRow.Delete xlShiftUp
            End If
        Case "Outstanding"
            ' 只有在Complete表修改为Outstanding时才执行移动
            If Sh.Name = "Complete" Then
                Set targetSheet = ThisWorkbook.Sheets("Outstanding")
                sourceRow.Copy targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Offset(1)
                sourceRow.Delete xlShiftUp
            End If
    End Select
    
    Application.EnableEvents = True
End Sub

代码说明 #

• Workbook_SheetChange事件：这是工作簿级的事件，会响应所有工作表的单元格修改，无需在每个工作表重复编写代码
• 范围限制：仅处理Outstanding和Complete两个工作表，且只对Z列的单个单元格修改做出反应，避免无效触发
• 逻辑严谨性：只有当前工作表与目标状态匹配时才执行移动（比如Outstanding表改Complete才移动），防止错误操作
• 对象明确引用：使用Sh指代触发事件的工作表，ThisWorkbook指代当前工作簿，避免依赖ActiveSheet导致的潜在问题

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