Excel·VBA按行拆分工作表

对应之前文章《Excel·VBA按列拆分工作表》，对Excel表格数据按照固定行数，将工作表拆分

工作表按行拆分为工作表

Sub 工作表按行拆分为工作表()'当前工作表（worksheet）按固定行数拆分为多个工作表，保存在当前工作簿（workbook）tm = Now()Set ws = Application.ActiveSheet  '当前工作表即为待拆分工作表
'--------------------参数填写：num_row，数字；title_row表头行数，数字，第1行为1向下递增title_row = 1  '表头行数，每个拆分后的sheet都保留num_row = 100  '拆分数据行数，按多少行数据进行拆分，不能完全拆分的，多余行数单独max_row = ActiveSheet.UsedRange.Rows.count'拆分sheet数量，向上取整sheet_count = WorksheetFunction.RoundUp((max_row - title_row) / num_row, 0)For i = 1 To sheet_count:Worksheets.Add(after:=Sheets(Sheets.count)).Name = "拆分表" & i  '最后添加新sheet，并命名With ActiveSheetws.Rows(1 & ":" & title_row).Copy  '本行复制表头，下行复制数据.Range("A1").PasteSpecial Paste:=xlPasteAll.Range("A1").PasteSpecial Paste:=xlPasteColumnWidthsws.Rows(num_row * (i - 1) + title_row + 1 & ":" & (num_row * i) + title_row).Copy .Range("A" & title_row + 1)End With'Exit For  '强制退出for循环，单次测试使用NextDebug.Print ("拆分完成，累计用时" & Format(Now() - tm, "hh:mm:ss"))  '耗时
End Sub

工作表按行拆分为工作薄

Sub 工作表按行拆分为工作薄()'当前工作表（worksheet）按固定行数拆分保存为多个工作簿（workbook），文件单独保存tm = Now()Application.Visible = False  '后台运行，不显示界面Application.DisplayAlerts = False  '不显示警告信息Set fso = CreateObject("Scripting.FileSystemObject")
'--------------------参数填写：num_row，数字；title_row表头行数，数字，第1行为1向下递增title_row = 1  '表头行数，每个拆分后的sheet都保留num_row = 100  '拆分数据行数，按多少行数据进行拆分，不能完全拆分的，多余行数单独Set ws = Application.ActiveSheet  '当前工作表即为待拆分工作表wb_path = Application.ActiveWorkbook.Path  '当前工作簿文件路径wb_name = Application.ActiveWorkbook.Name  '当前工作簿文件名和扩展名save_path = wb_path + "\拆分表"  '保存拆分后的表格保存路径max_row = ActiveSheet.UsedRange.Rows.count'拆分sheet数量，向上取整sheet_count = WorksheetFunction.RoundUp((max_row - title_row) / num_row, 0)If fso.FolderExists(save_path) ThenDebug.Print ("拆分文件保存路径已存在：" & save_path)Elsefso.CreateFolder (save_path)Debug.Print ("拆分文件保存路径已创建：" & save_path)End IfFor i = 1 To sheet_count:Workbooks.AddWith ActiveSheetws.Rows(1 & ":" & title_row).Copy  '本行复制表头，下行复制数据.Range("A1").PasteSpecial Paste:=xlPasteAll.Range("A1").PasteSpecial Paste:=xlPasteColumnWidthsws.Rows(num_row * (i - 1) + title_row + 1 & ":" & (num_row * i) + title_row).Copy .Range("A" & title_row + 1)End With'保存文件全名（文件路径、文件名、扩展名）save_file = save_path & "\" & fso.GetBaseName(wb_name) & "_拆分表" & i & "." & fso.GetExtensionName(wb_name)ActiveWorkbook.SaveAs filename:=save_fileActiveWorkbook.Close (False)'Exit For  '强制退出for循环，单次测试使用NextSet fso = Nothing  '释放内存Application.Visible = TrueApplication.DisplayAlerts = TrueDebug.Print ("工作表已拆分完成，累计用时" & Format(Now() - tm, "hh:mm:ss"))  '耗时End Sub