Excel VBA: Split Data and Save to New Workbooks - Optimized for SEO

///'Sub SplitDataAndSaveToNewWorkbooks()//nDim lastRow As Long//nDim curRow As Long//nDim sheetName As String//nDim newWorkbook As Workbook//nDim savePath As String//n'On Error Resume Next '当代码运行错误时忽略，继续向下运行//n//n//n' 清除上一次运行拆分的子表内容//nApplication.DisplayAlerts = False//nFor Each subTable In ThisWorkbook.Worksheets//nIf subTable.Name <> ///'data///' And subTable.Name <> ///'How to operate///' Then//n subTable.Cells.Clear//n Application.DisplayAlerts = False//n subTable.Delete//n Application.DisplayAlerts = True//nEnd If//nNext subTable//nApplication.DisplayAlerts = True//n//n//n'获取保存路径，这里为源数据表所在路径下的一个子文件夹///'SubTables///'//nsavePath = ThisWorkbook.path & ///'//SubTables///'//nIf Dir(savePath, vbDirectory) = ///'///' Then//n MkDir savePath//nEnd If//n//nWith Worksheets(///'data///') '修改为你的数据所在的Sheet名称//n lastRow = .Cells(.Rows.Count, ///'A///').End(xlUp).Row '修改为你的数据所在的列//n For curRow = 2 To lastRow '从第二行开始循环，第一行是标题//n sheetName = .Cells(curRow, ///'X///').Value '以第X列作为分割列//n If Not SheetExists(sheetName) Then ' SheetExists 函数用来判断是否存在同名的Sheet//n Worksheets.Add After:=Worksheets(Worksheets.Count) '添加新的Sheet//n ActiveSheet.Name = sheetName '以分割列的值命名新的Sheet//n End If//n .Rows(1).Copy Destination:=Worksheets(sheetName).Rows(1)//n .Rows(curRow).Copy Destination:=Worksheets(sheetName).Rows(Worksheets(sheetName).Cells(Worksheets(sheetName).Rows.Count, ///'X///').End(xlUp).Row + 1) '拷贝当前行到对应的Sheet//n Worksheets(sheetName).Columns.AutoFit '自适应单元格宽度//n Next//nEnd With//n//nFor Each subTable In ThisWorkbook.Worksheets//n If subTable.Name <> ///'data///' Then//n '判断是否为由///'data///'表拆分得到的子表//n Dim isSubTable As Boolean//n isSubTable = False//n For curRow = 2 To lastRow//n If subTable.Name = Worksheets(///'data///').Cells(curRow, ///'X///').Value Then//n isSubTable = True//n Exit For//n End If//n Next curRow//n '如果是///'data///'表拆分得到的子表，则保存到SubTables文件夹//n If isSubTable Then//n '拼接文件完整路径和文件名//n Dim filePath As String//n filePath = savePath & subTable.Name & ///'.xlsx/// '//n '如果文件已经存在，则删除旧文件//n If Dir(filePath) <> ///'///' Then//n Kill filePath//n End If//n //n Set newWorkbook = Workbooks.Add//n subTable.UsedRange.Copy newWorkbook.Worksheets(1).UsedRange//n newWorkbook.Worksheets(1).Columns.AutoFit '自适应单元格宽度//n newWorkbook.SaveAs filePath//n newWorkbook.Close SaveChanges:=False//n End If//nEnd If//nNext subTable//n//nWorksheets(///'How to operate///').Activate//nMsgBox ///'The data has been split and saved to SubTables.///'//n//nEnd Sub//n//nFunction SheetExists(shtName As String) As Boolean//n '判断Sheet是否存在//n SheetExists = False//n For Each sht In ThisWorkbook.Sheets//n If sht.Name = shtName Then//n SheetExists = True//n Exit Function//n End If//n Next sht//nEnd Function