如何修改现有VBA代码，避免删除Excel整行时触发运行报错

报错根因 #

• 删除整行时触发的SheetChange事件中，Target代表整行所有单元格，属于多单元格对象，直接调用Target.Column、Target.Value会因为对象包含多值抛出类型不匹配错误
• 原代码中未限定Range所属工作表，跨表触发事件时会出现逻辑偏差
• 未做边界校验：输入的工作表名不存在、目标工作表A列全空的场景都会触发运行错误
• 未设置错误捕获，一旦运行出错会导致Application.EnableEvents被永久设为False，后续所有事件都不会触发

修复后完整代码 #

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' 仅处理单个单元格修改的场景，删除整行/批量修改直接退出
    If Target.CountLarge > 1 Then Exit Sub
    ' 仅处理当前工作表A列、Y列的修改
    If Intersect(Target, Sh.Range("A:A,Y:Y")) Is Nothing Then Exit Sub
    
    ' 错误处理，避免异常时事件被永久关闭
    On Error GoTo ErrHandle
    Application.EnableEvents = False
    
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim findRst As Range
    
    Select Case Target.Column
        Case 1 ' A列修改时触发行移动
            ' 校验输入的工作表名是否存在
            On Error Resume Next
            Set targetSheet = Sheets(Target.Value)
            On Error GoTo ErrHandle
            If targetSheet Is Nothing Then GoTo ErrHandle
            
            ' 获取目标工作表A列最后一行非空行号
            With targetSheet.Range("A:A")
                Set findRst = .Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
                If Not findRst Is Nothing Then
                    lastRow = findRst.Row + 1
                Else
                    lastRow = 1 ' A列全空时默认从第一行开始
                End If
            End With
            
            ' 复制行到目标工作表后删除当前行
            Sh.Range("A" & Target.Row).Resize(, 25).Copy targetSheet.Cells(lastRow, 1)
            Target.EntireRow.Delete
    End Select
    
ErrHandle:
    Application.EnableEvents = True
End Sub

关键修改说明 #

• 开头增加多单元格判断，只要不是单个单元格修改（包括删除整行、批量粘贴等操作）直接退出，从根源避免报错
• 所有Range对象绑定当前触发事件的工作表Sh，保证逻辑仅作用于当前操作的工作表
• 新增工作表存在性校验、空值判断，覆盖边界场景
• 新增错误处理分支，无论代码是否运行出错，最终都会恢复事件触发状态，避免Excel功能异常

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