divida um grande excel em arquivos menores, mas inclua o cabeçalho em todos os arquivos

Question

Eu tenho uma macro que uso para dividir grandes planilhas do Excel em arquivos menores. Ele funciona perfeitamente, exceto que ele usa apenas a linha de cabeçalho no primeiro arquivo criado e essa linha de cabeçalho (linha 1) precisa estar no topo de cada novo arquivo. Existe uma maneira de modificar esse código para de alguma forma inserir essa linha em todos os arquivos?

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

Você terá que criar a etapa no código. Logo antes do loop For Next, grave o código ligado da primeira linha à primeira linha do novo arquivo. Depois disso, certifique-se de começar a escrever na linha dois. Isso é feito alterando a linha "For i = 2 to 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

Brinque com isso, mas essa é a ideia.