Excel数据表保留第一行表头分割成多个小文件宏语句

Sub SplitWorkbookWithHeader()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim newWb As Workbook
    Dim headerRow As Range
    Dim dataRange As Range
    Dim rowsPerFile As Long
    Dim lastRow As Long
    Dim i As Long, partNum As Long
    Dim startRow As Long, endRow As Long

    ' 设定每个文件的行数（不包括标题行）
    rowsPerFile = 100

    ' 定义当前工作表和最后一行
    Set ws = ThisWorkbook.Sheets(1) ' 要分割的工作表
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 获取标题行（假设标题在第1行）
    Set headerRow = ws.Rows(1)

    ' 开始分割
    partNum = 1
    startRow = 2 ' 数据从第2行开始，保留第1行为标题
    Do While startRow <= lastRow
        ' 确定每次导出数据的结束行
        endRow = Application.Min(startRow + rowsPerFile - 1, lastRow)

        ' 创建新的工作簿
        Set newWb = Workbooks.Add
        Set dataRange = ws.Rows(startRow & ":" & endRow)

        ' 将标题行复制到新工作簿
        headerRow.Copy newWb.Sheets(1).Rows(1)
        ' 复制数据行到新工作簿
        dataRange.Copy newWb.Sheets(1).Rows(2)

        ' 保存新工作簿
        newWb.SaveAs ThisWorkbook.Path & "\Split_Part_" & partNum & ".xlsx"
        newWb.Close False
        partNum = partNum + 1
        startRow = endRow + 1
    Loop

    MsgBox "文件已分割完成！"
End Sub