【将一个xls文件内的第一个sheet的数据（其中第一行是列名）按照指定行数进行切割，并生成新的xls文件进行保存，用宏代码实现】

本文链接：https://blog.csdn.net/weixin_43046974/article/details/130683904

将一个xls文件内的第一个sheet的数据（其中第一行是列名）按照指定行数进行切割，并生成新的xls文件进行保存，用宏代码实现

代码如下：

代码如下：

Option Explicit
Sub SplitWorksheetByRows()
    Dim RowLimit As Long
    Dim OriginalSheet As Worksheet
    Dim NewWorkbook As Workbook
    Dim LastRow As Long
    Dim SheetName As String
    Dim NumberOfWorkbooks As Integer
    Dim CurrentWorkBook As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    
    ' 设置要切割的行数
    RowLimit = InputBox("请输入需要切割的行数", "切割行数")
    
    ' 指定原工作表
    Set OriginalSheet = ThisWorkbook.Worksheets(1)
    
    ' 获取原工作表中的最后一行
    LastRow = OriginalSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 获取需要创建的工作簿数量
    NumberOfWorkbooks = Application.WorksheetFunction.Ceiling(LastRow / RowLimit, 1)
    
    ' 将原始工作表的数据按行数拆分到新的工作簿
    For CurrentWorkBook = 1 To NumberOfWorkbooks
        ' 创建新工作簿
        Set NewWorkbook = Workbooks.Add
        
        ' 计算开始和结束行
        StartRow = (CurrentWorkBook - 1) * RowLimit + 2
        EndRow = Application.WorksheetFunction.Min(StartRow + RowLimit - 1, LastRow)
        
        ' 复制标题行
        OriginalSheet.Rows(1).Copy Destination:=NewWorkbook.Worksheets(1).Rows(1)
        
        ' 复制数据
        OriginalSheet.Range(OriginalSheet.Cells(StartRow, 1), OriginalSheet.Cells(EndRow, OriginalSheet.Cells(1, Columns.Count).End(xlToLeft).Column)).Copy Destination:=NewWorkbook.Worksheets(1).Range("A2")
        
        ' 保存新工作簿
        SheetName = OriginalSheet.Name & "_" & Format(CurrentWorkBook, "00")
        
        ' 始终保存为.xls格式
        NewWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & "分段_" & SheetName & ".xls", xlExcel8


        NewWorkbook.Close SaveChanges:=False
    Next CurrentWorkBook
    
    ' 清理变量
    Set NewWorkbook = Nothing
    Set OriginalSheet = Nothing
    MsgBox "操作完成"
End Sub