简介：根据A列的内容进行筛选，将筛选出来的数据生成一个新的工作簿(可以放到指定文件夹下)，且工作簿名为筛选内容。
举例：
将上面的内容使用VBA会在当前test1下生成5个工作簿，工作簿名分别为TEST1.xls TEST2.xls TEST3.xls TEST4.xls TEST5.xls。且里面的内容也为筛选出来的内容：
如TEST1.xls内容为：
代码
Sub 根据A列单元格拆分为多个工作簿()Dim ws As WorksheetDim filterRange As Range, dataRange As RangeDim folderPath As StringDim newWorkbook As WorkbookDim filteredData As RangeDim filterValue As StringDim lastRow As LongDim i As LongDim count As Long ' 计数器，用来记录成功导出的工作簿数Dim folderName As String' 获取当前工作表Set ws = ThisWorkbook.ActiveSheet' 获取A列的最后一行lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row' 定义数据范围Set dataRange = ws.Range("A1").CurrentRegion ' 包含所有数据（标题行和数据行）'导出来的文件放在test1文件夹下面' 获取当前工作簿目录，并设置保存目录为 "test1" 文件夹folderPath = ThisWorkbook.Path & "\"folderName = "test1" ' 目标文件夹名If Dir(folderPath & folderName, vbDirectory) = "" Then' 如果 "test1" 文件夹不存在，则创建它MkDir folderPath & folderNameEnd If' 更新文件夹路径folderPath = folderPath & folderName & "\"' 清除之前的筛选（如果有）ws.AutoFilterMode = False' 初始化计数器count = 0' 遍历A列的每个非空单元格For i = 2 To lastRow ' 从A2开始filterValue = ws.Cells(i, 1).Value' 如果A列单元格为空，则跳出循环If filterValue = "" Then Exit For' 对A列应用筛选dataRange.AutoFilter Field:=1, Criteria1:=filterValue' 获取筛选后的可见数据On Error Resume NextSet filteredData = ws.AutoFilter.Range.SpecialCells(xlCellTypeVisible)On Error GoTo 0' 如果筛选结果存在，进行复制If Not filteredData Is Nothing Then' 创建新工作簿Set newWorkbook = Application.Workbooks.AddApplication.DisplayAlerts = FalsenewWorkbook.Sheets(1).Name = "Sheet1"' 复制筛选后的内容（包括标题行）filteredData.Copy Destination:=newWorkbook.Sheets(1).Range("A1")' 保存工作簿，并以当前筛选值命名，保存到 "test1" 文件夹newWorkbook.SaveAs folderPath & filterValue & ".xlsx", FileFormat:=xlOpenXMLWorkbooknewWorkbook.Close SaveChanges:=FalseApplication.DisplayAlerts = True' 增加计数器count = count + 1End IfNext i' 清除筛选ws.AutoFilterMode = False' 显示操作完成提示If count > 0 ThenMsgBox "导出完成！共导出了 " & count & " 个工作簿。", vbInformationElseMsgBox "没有符合条件的数据！", vbExclamationEnd If End Sub
注意：
使用VBA操作后是不可进行撤回的！！！
2.由于生成的工作簿的名字是根据筛选内容决定的，所以注意筛选的内容要符合文件的命名，否则会出错，如:筛选的内容是 \\ 这种特殊符号，给工作簿命名的时候会出错。
