把Excel工作簿的每个工作表提取出来保存为新工作簿

平台：MS office 2010

任务：有个excel工作簿，其中有上百个工作表，要求把每一个工作表全部保存为新工作簿，如果一个一个复制出来太傻了，可以用excel自带的VB解决。

方法：打开工作簿，在工作表上点右键，选择“查看代码”，打开Microsoft Visual Basic for Application对话框，在菜单栏，单击“插入”—“模块”。在模块对话框中输入如下代码：

Private Sub hjs()

  Dim sht As Worksheet

  Dim ThisBook As Workbook

  Set ThisBook = ActiveWorkbook

  For Each sht In ThisBook.Sheets

    sht.Copy

    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sht.Name & ".xlsx"

    ActiveWorkbook.Close

  Next

  MsgBox "分拆完毕"

End Sub

单击“保存”按钮，选择“否”，打开“另存为”对话框，选择保存位置（因为将提取出来的文件太多，最好保存在一个新文件夹里。），输入保存文件名，将保存类型选择为“Excel启用宏的工作簿（*.xlsm）”，单击“保存”。

在Microsoft Visual Basic for Application对话框单击工具栏上的运行按钮，excel将自动提取各个工作表为单一工作簿。