разбить большой Excel на более мелкие файлы, но включить заголовок во все файлы

Question

У меня есть макрос, который я использую, чтобы разбить большие таблицы 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

Answer 1

Вам придется создать шаг в коде. Прямо перед циклом For Next напишите код, жестко привязанный от первой строки к первой строке нового файла. После этого просто убедитесь, что вы начинаете писать во второй строке. Это достигается изменением строки «Для i = 2 на LR Step 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

Играть с этим, но это идея.