Sub fenchai()
On Error Resume Next
Dim WB As Workbook, i As Integer
Set WB = ThisWorkbook
For i = 1 To WB.Worksheets.Count '获得工作簿中表的个数
WB.Worksheets(i).Copy '复制工作表
ActiveWorkbook.SaveAs Filename:="c:\分拆文档\" & WB.Worksheets(i).Name & "TB.xls" '保存文档
ActiveWindow.Close
Next i
End Sub