如何用VBA将多工作表Excel按指定行数拆分为同结构新文件

Sub Test()
    Dim wb As Workbook
    Dim ThisSheet As Worksheet
    Dim NewSheet As Worksheet
    Dim NumOfColumns As Integer
    Dim RangeToCopy As Range
    Dim RangeOfHeader As Range
    Dim WorkbookCounter As Integer
    Dim RowsInFile As Integer
    Dim p As Long

    Application.ScreenUpdating = False

    ' 初始化配置
    WorkbookCounter = 1
    RowsInFile = 20 ' 每个文件单表存储的业务数据行数（不含表头）

    ' 按拆分批次循环，生成对应数量的新文件
    For p = 2 To ThisWorkbook.Sheets(1).UsedRange.Rows.Count Step RowsInFile
        ' 新建空白工作簿
        Set wb = Workbooks.Add
        ' 遍历原工作簿所有工作表，逐个处理
        For Each ThisSheet In ThisWorkbook.Sheets
            ' 新工作簿新增对应工作表，同步工作表名称
            If wb.Sheets.Count < ThisWorkbook.Sheets.Count Then
                Set NewSheet = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
            Else
                Set NewSheet = wb.Sheets(ThisSheet.Index)
            End If
            NewSheet.Name = ThisSheet.Name
            
            NumOfColumns = ThisSheet.UsedRange.Columns.Count
            ' 复制当前工作表表头
            Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns))
            RangeOfHeader.Copy NewSheet.Range("A1")
            
            ' 复制当前批次对应区间的业务数据
            Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 1, NumOfColumns))
            RangeToCopy.Copy NewSheet.Range("A2")
        Next ThisSheet
        
        ' 保存并关闭当前生成的拆分文件
        wb.SaveAs "MyTest" & WorkbookCounter & ".xlsx", FileFormat:=51
        wb.Close
        
        WorkbookCounter = WorkbookCounter + 1
    Next p

    Application.ScreenUpdating = True
    Set wb = Nothing
    Set ThisSheet = Nothing
    Set NewSheet = Nothing
End Sub

• 外层先按拆分批次循环，每一批次生成1个新工作簿，避免重复创建销毁工作簿带来的性能损耗
• 新增For Each ThisSheet In ThisWorkbook.Sheets循环遍历原文件所有工作表，替换原来仅读取活动工作表的逻辑
• 新工作簿创建后会自动匹配原文件的工作表数量、工作表名称，保证结构和原文件完全一致
• 每个工作表单独读取表头和对应批次的20条业务数据，写入新工作簿的对应工作表，不同工作表的拆分区间完全同步，符合需求要求的对应区间规则

内容的提问来源于stack exchange，提问作者Abhijit