一个工作簿中包括N个工作表，将各个工作表拆分成工作簿。

工作表数量不定，表内内容不限，拆分后保存于当前文件夹内。

Sub Sample()
Dim MySheetsCount As Long
For MySheetsCount = 1 To Sheets.Count
    Sheets(MySheetsCount).Copy
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Sheets(1).Name & ".xlsx"
    ActiveWindow.Close
Next
End Sub

原博客各种作……所以换阵地了，不过每篇都搬过来，实在有点累，想看就自己看吧：http://blog.sina.com.cn/pureiceshadow