Excel VBA 将工作表按列拆分且生成新工作表（同个工作簿内）

需求：现在有一张工作表，需要按业务员姓名分成小的工作表，放在同一个工作簿里。

源表格：

效果：

Sub splitSht()
Dim sht As Worksheet
Dim D As Object
Dim j As Integer
Dim t
Dim SourceSht, KeyColumn As String
    
    SourceSht = "销售金额" '源sheet表，即总的明细表sheet名称，命名为SourceSht
    KeyColumn = "B"  '关键列，业务员所在列，即拆分数据的依据，命名为KeyColumn
    
    t = Timer  '获取程序开始前的时间
    Set sht = ThisWorkbook.Worksheets(Sheet1)
    Set D = CreateObject("scripting.dictionary")  '创建一个字典，命名为D
    With sht
        rrow = .Range(KeyColumn & "65535").End(xlUp).Row '从关键列的最大行数65535往上数，获取有数据的最后一行的行数
        For i = 2 To rrow  '从第二行到最后一行，循环进行
            strr = .Range(KeyColumn & i).Value  '获取关键列的当前行所在单元格的数值，即当前业务员的名字，命名为strr
            If Not D.exists(strr) Then  '判断当前业务员strr是否已经在字典D中，如果不在，则
                D.Add strr, .Range("A1").Resize(1, 30)  '第一步，将A1所在行（即表头）添加进字典D中。.Range("A1").Resize(1, 30)指以A1为基准向下向右获取数据，向下获取1行（含本行），向右获取30列（含本列）的数据
                Set D.Item(strr) = Union(D.Item(strr), .Range("A" & i).Resize(1, 30))  '第二步，将业务员名字（键）对应的信息（值）更新为表头和该业务员strr所在行的合集，即添加业务员所在行
            Else
                Set D.Item(strr) = Union(D.Item(strr), .Range("A" & i).Resize(1, 30)) '如果strr已在字典D中，则不需要第一步添加表头，直接进行第二步添加该业务员名字strr所在行
            End If
        Next
        k = D.keys '键=业务员名字
        i = D.items '值=所有含有该业务员名字的行的合集
        For j = 0 To D.Count - 1
            ThisWorkbook.Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)  '新建一个sheet表，建在已有的sheet表后面
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = k(j) '将新sheet表命名为业务员名字
            i(j).Copy Worksheets(k(j)).Range("A1")  '将字典中的内容复制粘贴到业务员sheet表里，从A1开始粘贴
            Worksheets(k(j)).Cells.EntireColumn.AutoFit  ''调整粘贴后的格式，自适应列宽
        Next
    End With
    MsgBox "程序运行完成，共耗时：" & Timer - t & "秒"  '用程序结束后的时间减掉开始前的时间，获取程序运行耗时，并弹出输出框显示
    
End Sub

1. 每一行都添加了注释，因为是帮同事写的，便于不懂任何代码的人理解。我自己也是小白，上面的代码是参考别人的代码改出来的，详见链接：https://blog.csdn.net/q215046120/article/details/121023362#:~:text=Vba%20%E4%B8%80%E5%BC%A0%E5%B7%A5%E4%BD%9C%E8%A1%A8%E6%8B%86%E5%88%86%E5%A4%9A%E5%BC%A0%E5%B7%A5%E4%BD%9C%E8%A1%A8%201%20Sub%20splitSht%20%28%29%202%20Dim,%3D%20.Range%20%28%20%22A65535%22%20%29.%20End%20%28xlUp%29.Row%20%E6%9B%B4%E5%A4%9A%E9%A1%B9%E7%9B%AE

2.额外写了计算程序运行时间的代码，不需要的可以删掉。