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

如：EXCEL有以下列：姓名，年龄，性别，电话，地址，公司。
把：姓名，年龄，性别拆分作为一个工作簿；
把：电话，地址，公司拆分作为一个工作簿；

操作方法如下：
将原表复制若干个表，每个表里删除不需要的列。

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