"Sub 按关键字拆分工作表() Dim d As New Dictionary With Sheets("汇总表") arr = .[a2].CurrentRegion For i = 3 To UBound(arr) d(arr(i, 4)) = i Next For j = 0 To d.Count - 1 .Range("$A2:$N2").AutoFilter 4, d.Keys(j) Sheets.Add , Sheets(Sheets.Count) ActiveSheet.Name = d.Keys(j) .[a1].CurrentRegion.Copy ActiveSheet.[a1] Next j .Range("$A2:$N2").AutoFilter .Activate End With End Sub"添加根据"汇总表"自动更新数据到分表中

可以通过在 "汇总表" 中添加数据时自动更新分表数据，具体步骤如下：

1. 在 "汇总表" 中添加新数据时，将其插入到正确的位置，并保证关键字列（假设是第四列）的值与已有数据不重复。

2. 在 "汇总表" 的 VBA 代码中添加以下过程：

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:$N2").Copy ws.Range("A1")
    Else
        Dim i As Long
        i = Application.Match(key, Sheets("汇总表").Range("D:D"), 0)
        Sheets("汇总表").Range("$A2:$N2").Offset(i - 1).Resize(1).Copy ws.Range("A1")
    End If
End Sub

3. 保存代码并关闭 VBA 编辑器。

现在，当你在 "汇总表" 中添加新数据时，代码将自动检测关键字列的值，并在相应的分表中添加新行或更新现有行。如果分表不存在，则会自动创建一个新的分表并将 "汇总表" 的表头复制到新表中。