розділити великий excel на менші файли, але включити заголовок у всі файли

У мене є макрос, який я використовую для розбиття великих таблиць Excel на більш дрібні файли. Він працює чудово, за винятком того, що він використовує лише заголовок у першому створеному файлі, і цей рядок заголовка (рядок 1) повинен знаходитися у верхній частині кожного нового файлу. Чи є спосіб змінити цей код, щоб якось вставити цей рядок у всі файли?

Sub SplitSheets()

' Save sheet in rows of 25000 to incremental CSV files
' JBeaucaire (7/27/2009)

Dim LR As Long, i As Long, Cntr As Long

Dim ws As Worksheet, OldDir As String

If MsgBox("Is this the sheet to parse data from?", vbYesNo + vbQuestion) = vbNo Then Exit Sub LR = Range("A" & Rows.Count).End(xlUp).row

Set ws = ActiveSheet

OldDir = CurDir     'memorizes the user's current working path

Dim v: v = Evaluate("ISREF(TEMP!A1)")

    If Not v Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    Else
        Sheets("Temp").Activate
        Cells.Clear
    End If

ChDir "C:\Users\BartB\Desktop\sheets"     'path to save CSV file into

    For i = 1 To LR Step 2000
        ws.Rows(i & ":" & i + 1999).Copy Range("A1")
        Cntr = Cntr + 1
        ActiveWorkbook.SaveAs Filename:="File" & Cntr & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        Cells.Clear
    Next i

ChDir OldDir        'restores user's original working path
End Sub

Вам доведеться створити крок у коді. Прямо перед циклом For Next напишіть код жорсткого підключення від першого рядка до першого рядка нового файлу. Після цього просто переконайтеся, що ви починаєте писати з другого рядка. Це досягається зміною рядка "Для i = 2 на крок LR 2000"

    ws.Rows("1:1").Copy Range("A1")
    Cntr = Cntr + 1
    ActiveWorkbook.SaveAs Filename:="File" & Cntr & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    Cells.Clear

For i = 1 To LR Step 2000
    ws.Rows(i & ":" & i + 1999).Copy Range("A1")
    Cntr = Cntr + 1
    ActiveWorkbook.SaveAs Filename:="File" & Cntr & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    Cells.Clear
Next i

Пограйте з цим, але це ідея.