用excel宏对sheet按指定列内容命名拆分成若干文件

Question

名称 数量 单价
a 23 1.5
a 24 1.6
a 25 1.7
b 26 1.8
b 27 1.9
c 28 2
c 29 2.1
假定以上表格，想通过宏实现如下条件：
按“名称”列同一名称的记录拆分成新的独立的excel文件，同时新文件名称是“名称”列的内容，比如，拆后的新文件内容若是以下内容，要求该文件名是a.xls
名称 数量 单价
a 23 1.5
a 24 1.6
a 25 1.7
谢谢大家。

Answer 1

Sub 列数据转文件()
Dim Twork As Workbook, Tsht As Worksheet, nameDic, EndRow As Long
Application.ScreenUpdating = False
Set nameDic = CreateObject("Scripting.Dictionary")
EndRow = [A65536].End(xlUp).Row'获取A列末行,根据实际修改为某列
For Each rng In Range("A2:A" & EndRow)
'遍历A列第二行开始的所有关键字,如非A列,请将A修改成其它列
  nameDic(rng.Value) = "" '将关键字添加至字典对象中（不会重复）
Next
If ActiveSheet.AutoFilterMode = False Then Range("A1:C1").AutoFilter
'将工作表A1:C1区域设置为自动筛选,按自己需要修改区域
For Each t In nameDic.keys'遍历字典中所有的关键字
If t <> "" Then
    ActiveSheet.Range("$A$1:$C$" & EndRow).AutoFilter Field:=1, Criteria1:=t
    '从自动筛选中筛选值为变量t的所有区域
    Set Twork = Workbooks.Add: Set Tsht = Twork.Sheets(1)
    '新建工作簿twork对象,设置Tsht工作表对象
    Range("A1").CurrentRegion.Copy Tsht.Range("A1")
    '将自动筛选出的所有结果复制到新的工作薄中
    Twork.SaveAs t: Twork.Close: Set Tsht = Nothing: Set Twork = Nothing
    另存新的工作簿,名字为变量t(既A列中的关键字),然后关闭工作簿,清空对象变量
End If
Next
Application.ScreenUpdating = True
End Sub