将大型 Excel 拆分为较小的文件,但在所有文件中都包含标题

将大型 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

答案1

您必须在代码中创建步骤。在 For Next 循环之前,将代码从新文件的第一行硬连线到第一行。之后,只需确保从第二行开始编写即可。这可以通过将“For 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

玩一玩,但这就是想法。

相关内容