一个工作簿中包含很多表格，改怎样将这些表格拆分成多个文件呢？

Sub chaifenwenjian()

Dim sht As Worksheet
Dim shp As Object
Dim i, j As Integer

For Each sht In Sheets

    '复制数据到新的工作簿
    sht.Copy
    ActiveWorkbook.SaveAs Filename:="C:\Users\lenovo\Desktop\拆分表格数据\" & sht.Name & ".xlsx"
    ActiveWorkbook.Sheets(1).Columns("M:P").ClearContents
    
    '添加合计
    j = ActiveWorkbook.Sheets(1).Range("a65536").End(xlUp).Row
    ActiveWorkbook.Sheets(1).Range("I" & j + 1) = "合计"
    ActiveWorkbook.Sheets(1).Range("J" & j + 1) = WorksheetFunction.Sum(Sheets(1).Range("j3:j" & j))
    
    '添加列
    ActiveWorkbook.Sheets(1).Range("M2") = "点单跟踪"
    ActiveWorkbook.Sheets(1).Range("N2") = "未补单原因"
    ActiveWorkbook.Sheets(1).Range("O2") = "预计补单时间"

    '格式
    ActiveWorkbook.Sheets(1).Range("L2:L" & j).Copy
    ActiveWorkbook.Sheets(1).Range("M2:O" & j).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Sheets(1).Range("M2:O2").Interior.Color = 65535
    ActiveWorkbook.Sheets(1).Range("M2:O2").Font.Color = -16776961
    
    '删除图形
    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next shp
    ActiveWorkbook.Save
    ActiveWorkbook.Close

Next

End Sub

改写法的代码是，最好只打开要拆分的表格，此处采用的是ActiveWorkbook，即当前活动工作簿。如果同时打开其它表格并且忘记切换到要拆分的表格，会出问题。