VBA一个sheet多行按照固定行数分割到多个excel中

Sub SplitWorkbook()

    Dim SourceSheet As Worksheet
    Set SourceSheet = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    Dim CurrentRow As Long
    Dim StartRow As Long
    Dim EndRow As Long
    Dim TargetWorkbook As Workbook
    Dim TargetSheet As Worksheet
    Dim Index As Integer
    
    CurrentRow = 2 ' Assuming row 1 has headers
    StartRow = 2
    Index = 1
    
    While CurrentRow <= SourceSheet.UsedRange.Rows.Count
        
        Set TargetWorkbook = Application.Workbooks.Add
        Set TargetSheet = TargetWorkbook.Sheets(1)
        
        If CurrentRow + 499 > SourceSheet.UsedRange.Rows.Count Then
            EndRow = SourceSheet.UsedRange.Rows.Count
        Else
            EndRow = CurrentRow + 499
        End If
        
        SourceSheet.Rows(1).Copy TargetSheet.Rows(1)
        SourceSheet.Rows(StartRow & ":" & EndRow).Copy TargetSheet.Rows(2)
        TargetWorkbook.SaveAs "D:\Temp\File_" & Index & ".xlsx" ' change the file path as needed
        TargetWorkbook.Close SaveChanges:=True
        
        CurrentRow = EndRow + 1
        StartRow = CurrentRow
        Index = Index + 1
        
    Wend

End Sub