"Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("A2:N" & Rows.Count)) Is Nothing Then Exit Sub If Target.Row < 3 Then Exit Sub Dim key As String key = Cells(Target.Row, 4).Value If key = "" Then Exit Sub Dim ws As Worksheet On Error Resume Next Set ws = Worksheets(key) On Error GoTo 0 If ws Is Nothing Then Set ws = Worksheets.Add(after:=Sheets(Sheets.Count)) ws.Name = key ' 避免复制合并单元格，只复制第一个单元格 Sheets("汇总表").Range("$A2:$A2,$B2:$N2").Copy ws.Range("A1") Else Dim i As Long i = Application.Match(key, Sheets("汇总表").Range("D:D"), 0) ' 避免复制合并单元格，只复制第一个单元格 Sheets("汇总表").Range("$A2:$A2,$B2:$N2").Offset(i - 1).Resize(1).Copy ws.Range("A1") End If End Sub"运行到"Sheets("汇总表").Range("$A2:$A2,$B2:$N2").Offset(i - 1).Resize(1).Copy ws.Range("A1")"提示应用程序定义或对象定义错误,修改代码

可能是因为找不到"汇总表"这个工作表，你可以尝试使用工作表的索引号来代替工作表的名称。修改后的代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("A2:N" & Rows.Count)) Is Nothing Then Exit Sub
    If Target.Row < 3 Then Exit Sub
    Dim key As String
    key = Cells(Target.Row, 4).Value
    If key = "" Then Exit Sub
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(key)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
        ws.Name = key
        ' 避免复制合并单元格，只复制第一个单元格
        Sheets(1).Range("$A2:$A2,$B2:$N2").Copy ws.Range("A1")
    Else
        Dim i As Long
        i = Application.Match(key, Sheets(1).Range("D:D"), 0)
        ' 避免复制合并单元格，只复制第一个单元格
        Sheets(1).Range("$A2:$A2,$B2:$N2").Offset(i - 1).Resize(1).Copy ws.Range("A1")
    End If
End Sub

我这里将"汇总表"改为了索引号为1的工作表，你可以根据实际情况修改。