相信很多同学都遇到过如下使用工作情形：一张销售订单总表，需要按照销售员拆分成多个单表，除了按照销售员一个个筛选、复制到新文件，是否可以用vba来做呢？该怎么做呢？案例案例名称
待拆分工作表.xlsx：
按照姓名拆分成“张三.xlsx”、“李四.xlsx”和“王二.xlsx”。
你只需要打开附件中的“按照第一列拆分表格.xlsm”，点击拆分按钮即可。
这个vba程序我已经包装好，按照说明使用就可以了，如果需要学习代码，代码也未加密，可以直接查看。
小工具获取方法：
一、将本文分享到朋友圈，并截图；
二、将截图私信发送给本号，我将会回复给您百度网盘下载的地址和提取码。
关键代码：
Sub main_module()
Application.ScreenUpdating = True
'打开待拆分表格
Dim bookA As Workbook
Dim sheetA As Worksheet
Dim rowcountA As Long
Dim resDicA As Object
Set resDicA = CreateObject("Scripting.Dictionary")
Call public_module.getObjs(ThisWorkbook.path & "\待拆分表格.xlsx", "Sheet1", resDicA)
Set bookA = resDicA.Item("book")
Set sheetA = resDicA.Item("sheet")
rowcountA = resDicA.Item("sheetRowsCount")
'新建文件对象
Set fso = CreateObject("scripting.filesystemobject")
'循环第一列
Dim filename1, filename As String
Dim i
For i = 2 To rowcountA
filename1 = sheetA.Cells(i, 1)
If Trim(filename1) <> "" Then
filename = filename1
Else
filename = "筛选值为空"
End If
filenamelong = filename & ".xlsx"
If fso.FileExists(ThisWorkbook.path & "\" & filenamelong) = True Then
'MsgBox "文件存在"
Else
'MsgBox filename & "文件不存在"
Set newbk = Workbooks.Add
sheetA.[a1].AutoFilter 1, filename1
sheetA.[a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy newbk.Sheets(1).[a1]
dirname = ThisWorkbook.path & "\" & filenamelong
ActiveWorkbook.SaveAs dirname
Workbooks(filenamelong).Close True
Application.ScreenUpdating = True
End If
Next i
bookA.Close Savechanges:=True
End Sub
