把工作簿按照工作表拆分成多个工作簿。

Sub Macro1() ' ' Macro1 Macro ' 宏由 net 录制，时间: 2011/12/29 '

'  '   Sheets("Format").Select  '   Sheets("Format").Copy '    ChDir "C:\Users\net\Desktop"  '   ActiveWorkbook.SaveAs Filename:="C:\Users\net\Desktop\Book22222221.xls", FileFormat:=xlNormal, Password:="123456",

'WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False    

   Dim ps As String  

 Dim pt As String

  Dim sname As String    

     For i = 1 To ActiveWorkbook.Worksheets.Count

If ActiveWorkbook.Worksheets(i).Name <> "汇总" Then

 ps = Right(ActiveWorkbook.Worksheets(i).Name, 8) '

ps = ActiveWorkbook.Worksheets(i).Cells(2, 10).Value '编号

 sname = ActiveWorkbook.Worksheets(i).Cells(3, 12).Value & ".xls" ' 姓名

ActiveWorkbook.Worksheets(i).Select

ActiveWorkbook.Worksheets(i).Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ActiveWorkbook.SaveAs Filename:="d:\2011台帐拆分后\" & sname, FileFormat:=xlNormal, Password:=ps, WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Close True

 

End If

Next

 End Sub