Excel按固定行数拆分为多个Excel

步骤 1

打开VBA编辑器

打开你的Excel文件。

按 Alt + F11 打开VBA编辑器。

在VBA编辑器中，点击 插入 -> 模块，创建一个新的模块。

步骤 2:

编写VBA代码

在新创建的模块中输入以下VBA代码：

Sub SplitWorkbookByRows()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1) '假设要拆分的工作表是第一个工作表
    Dim totalRows As Long
    totalRows = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row '获取总行数
    Dim rowsPerFile As Long
    rowsPerFile = InputBox("请输入每个文件包含的行数：") '用户输入每份文件的行数
    Dim fileCounter As Integer
    fileCounter = 1
    Dim startRow As Long
    startRow = 2 '假设第一行是标题行，从第二行开始拆分
    Dim endRow As Long
    Dim newWb As Workbook
    
    Do While startRow <= totalRows
        endRow = startRow + rowsPerFile - 1
        If endRow > totalRows Then
            endRow = totalRows
        End If
        
        '复制数据到新工作簿
        Set newWb = Workbooks.Add
        ws.Rows("1:1").Copy Destination:=newWb.Sheets(1).Range("A1") '复制标题行
        ws.Rows(startRow & ":" & endRow).Copy Destination:=newWb.Sheets(1).Range("A2")
        
        '保存新工作簿
        newWb.SaveAs ThisWorkbook.Path & "\Split_" & fileCounter & ".xlsx"
        newWb.Close
        
        startRow = endRow + 1
        fileCounter = fileCounter + 1
    Loop
    
    MsgBox "拆分完成！"
End Sub

运行以上代码

效果图