您好，我在网上看到你在2012年7月19日回答了关于根据总表自动生成分表的问题，还有一些疑问希望不吝赐教~~

好的，如有疑问，欢迎交流~
Private Sub CommandButton1_Click()
Dim Sh As Worksheet
Dim arr, bod, k%, m, n, i
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary") '创建字典对象
Set Sh = ThisWorkbook.Sheets("Sheet1") ' ThisWorkbook.Sheets("Sheet1") 定义为Sh
arr = Sh.Range("A2", Sh.[b65536].End(3)(1, 16)) '定义数组
For k = 1 To UBound(arr) '创建循环，UBound(arr)为数组的维数
Dic(arr(k, 2)) = Dic(arr(k, 2)) + 1 '可理解为删除重复项，经过这一循环，可以把arr里面不重复项提取到Dic中
Next
For m = 1 To Dic.Count
Dim newwb As Workbook
Set newwb = Workbooks.Add '创建新表
Set shh = newwb.Sheets(1)
i = 2
For n = 1 To Sh.[b65536].End(3).Row
If Sh.Cells(n, 2) = Application.Index(Dic.keys, m) Then '如果原表中第二行包含Dic某一值，则把这一行的值拷到新表中
Sh.Activate
Sh.Range("a1:p1").Copy Destination:=shh.Range("a1:p1")
arr = Sh.Range(Cells(n, 1), Cells(n, 16))
shh.Cells(i, 1).Resize(1, 16) = arr
i = i + 1
End If
Next n
shh.Range("a1:p" & i - 1).Borders.LineStyle = 7 '设置线型
arr = WorksheetFunction.Substitute(shh.Cells(i - 1, 16), "/", "-") '表名一部分
shh.Name = Application.Index(Dic.keys, m) '表名一部分，也是Dic中不重复项可通过这句提取出来
bod = ThisWorkbook.Path & "\" & "SHA-" & Application.Index(Dic.keys, m) & " " & arr & ".xls" '表路径和表名
newwb.SaveAs bod '按照条件把原表中的数据拷贝到新表后，另存为新表
newwb.Close False
Next m
On Error Resume Next
Erase arr
Set Dic = Nothing
End Sub
思路就是用字典把arr里面不重复项查找出来，然后以这些不重复项作为关键字，查找对应原表所在行，复制粘贴到各个新表，再保存。