将多个工作表保存为单独的工作簿

除非注明，文章均为战战如疯原创，转载请保留链接: http://www.zhanzhanrufeng.com/cat4/99.html，VBA交流群273624828。

今天我们来讲另一个案例。假设你手上有一个工作簿，里面包含了N多的工作表，现在由于工作需要你要将这些工作表都拆分为单独的工作簿来向不同的部门下发，那这个用VBA应该怎么实现呢？假设我有示例文件所示的这样一个工作簿，里面有9个工作表，我需要将这9个工作表保存为9个单独的工作簿并且以工作表的名称来命名新建的工作簿。看代码

Sub 另存所有工作表为工作簿()
Dim sht As Worksheet, mypath
Application.ScreenUpdating = False
mypath = ThisWorkbook.Path & "\"     '取得当前文件夹路径
For Each sht In Sheets           '对工作簿中的每一个Sheet进行操作
sht.Copy                                '复制工作表
Kill mypath & sht.Name & ".xls"      '删除同路径下同名工作簿
ActiveWorkbook.SaveAs mypath & sht.Name & ".xls" '保存复制的工作表
ActiveWorkbook.Close           '关闭新保存的工作簿
Next
Application.ScreenUpdating = True
End Sub

上面的代码很简单。在这里说明一下，整个工作表的复制和部门区域的复制是不同的，工作表复制时会产生一个新的工作簿副本，而且这个工作簿副本就是当前活跃工作簿即ActiveWorkbook，而你复制一个区域的话，比如复制所有有内容的区域sheet1.usedrange，则复制的就是内容，而不会产生一个新的工作簿。所以在将Excel工作表另存为工作簿的时候只要用工作表的Copy方法即可以了，而不必先新建一个工作簿，再将内容复制进去，这样思路虽对，但显然麻烦了。本节示例文件下载地址http://pan.baidu.com/s/1qW17G9A