批量把 worksheet保存为workbook

方法1

Sub saveas()   '这个是不是就是做打表工具的一部分？比如这就是导表


Dim wb As Workbook
Dim sht As Worksheet
Dim strpath As String



strpath = ThisWorkbook.path & "\"            ‘这样能自动读路径，好技巧
For Each sht In ThisWorkbook.Worksheets
Rem For Each wsh In ActiveWindow.SelectedSheets
Rem 这个是可以先选择部分的表？
    sht.Copy              ‘这里不写会怎么样？
    With ActiveWorkbook   '这里不能用thisworkbook了，因为被关闭了?
         .saveas strpath & sht.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
         .Close
    End With
Next


End Sub

方法2

完整的测试过程

Sub saveas()   '这个是不是就是做打表工具的一部分？比如这就是导表


Dim wb As Workbook
Dim sht As Worksheet
Dim strpath As String

strpath = ThisWorkbook.path & "\"





Rem For Each sht In ActiveWindow.SelectedSheets   '这个先选中部分表
Rem For Each sht In ThisWorkbook.SelectedSheets   '这个先选中部分表 thisworkbook没这个方法。。。
Rem For Each sht In ThisWorkbook.worksheets.Select  '?也不行，没指定选中了哪个
Rem select 方法默认是替代性的，只同时选中1个。 但可以设置为选多个
Rem active肯定只有1个？
Rem For Each sht In ThisWorkbook.Worksheets("selected").select表  '下标越界，没法这么表示选中的表


For Each sht In ActiveWindow.SelectedSheets


    sht.Copy  '如果不加，源和目标文件类型对不上，则会提示宏无法保存在xlsx内。点确定也会完全复制一份新的?而不是分开复制？
    With ActiveWorkbook   '这里不能用thisworkbook了，因为新表创建后就激活了需要这时候重命名
         .saveas strpath & sht.Name & ".xlsx" ', FileFormat:=xlOpenXMLWorkbook  '如果不加fileformat ?
         .Close
    End With
Next

End Sub

所以  

saveas      会把原表另存为  理论上前面可以先copy

savecopyas

fileformat:=xlopenxmlworkbook 想当于保存为什么类型的文件。官方msdn有介绍

方法3 savecopyas

标签：ThisWorkbook,Dim,VBA,sht,worksheet,Rem,Each,workbook,strpath
来源： https://blog.csdn.net/xuemanqianshan/article/details/89305206