Excel 每5000行将页眉拆分为多个新页

我试图使用宏将电子表格每5000行分割成多个新文件，并保留标题。我尝试了此代码，但收到错误消息“

代码：

根据“调试”从此处突出显示错误：

---

我建议您跳过GetOpenFilename选项，选择另一个选项-具体使用以下格式：

"C:\Path\To\ABCDE.xlsx"  

---

如John_w on所述。

只需将其更改为ActiveWorkbook即可 除非您计划为另一个工作簿运行它，否则将使用另一个工作簿

Sub Macro1()
Dim inputFile As String, inputWb As Workbook
    Dim lastRow As Long, row As Long, n As Long
    Dim newCSV As Workbook

With ActiveWorkbook.Worksheets(1)
    lastRow = .Cells(Rows.Count, "A").End(xlUp).row

    Set newCSV = Workbooks.Add

    n = 0
    For row = 2 To lastRow Step 5000
        n = n + 1
        .Rows(1).EntireRow.Copy newCSV.Worksheets(1).Range("A1")
        .Rows(row & ":" & row + 5000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A2")

        'Save in same folder as input workbook with .xlsx replaced by (n).csv
        newCSV.SaveAs Filename:=n & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    Next
End With

newCSV.Close saveChanges:=False

End Sub

你的问题出在

inputFile=GetOpenFilename

设置inputWb=Workbooks.Open（inputFile）

您没有告诉它getopenfilename是什么

没有必要重新开放

---

使用ACtiveWorkbook

问题可能出在

GetOpenFilename

中。在分配后立即放置

Debug.Print inputFile

（例如

inputFile=GetOpenFilename

），并检查立即窗口（Ctrl+g）崩溃后查看报告内容。您是否尝试过

inputFile=Application.GetOpenFilename

？当我尝试此“Sub-Macro1（）将inputFile设置为字符串，将inputWb设置为工作簿Dim lastRow As Long，row As Long，n只要将newCSV设置为工作簿inputFile=GetOpenFilename Debug.Print inputFile End Sub”，然后我尝试了“inputFile=Application.GetOpenFilename”，它就会打开finder来查找文件。如果我选择了我的文件，它会显示错误“Open object failed”，并且仍然突出显示“Set inputWb=Workbook.Open（inputFile）“我不是想推卸责任，我怀疑你的“%temp%”文件夹中的临时文件已经损坏。重新启动计算机，轻按Windows键并键入%TEMP%，然后按enter键。从该文件夹中删除所有可以删除的内容。某些文件可能正在使用中，但在重新启动后，您应该能够从中获取损坏的Excel临时图像。我不知道我的路径是否错误，或者是什么，“/Users/annlll/Downloads/Workbook5.xlsx”表示找不到。好的，路径问题是可以的，但它要求我打开该文件，但它已经打开了。如果我说是，它会再次打开，我的宏也会消失，如果我说不是，它仍然是同一个错误“Open object failed”

"C:\Path\To\ABCDE.xlsx"  

Sub Macro1()
Dim inputFile As String, inputWb As Workbook
    Dim lastRow As Long, row As Long, n As Long
    Dim newCSV As Workbook

With ActiveWorkbook.Worksheets(1)
    lastRow = .Cells(Rows.Count, "A").End(xlUp).row

    Set newCSV = Workbooks.Add

    n = 0
    For row = 2 To lastRow Step 5000
        n = n + 1
        .Rows(1).EntireRow.Copy newCSV.Worksheets(1).Range("A1")
        .Rows(row & ":" & row + 5000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A2")

        'Save in same folder as input workbook with .xlsx replaced by (n).csv
        newCSV.SaveAs Filename:=n & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    Next
End With

newCSV.Close saveChanges:=False

End Sub