CODEWITHSUNDEEP
excelvba
Angie Li
Angie Li

Reputation: 185

Split every 5000 rows with header into multiple new sheets

I was trying to use macro to split my spreadsheet into multiple new files for every 5000 rows and keep the header. I tried this code, but got error message "enter image description here

Code:

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

inputFile = GetOpenFilename

Set inputWb = Workbooks.Open(inputFile)

With inputWb.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:=Replace(inputWb.FullName, ".xlsx", "(" & n & ").csv"), FileFormat:=xlCSV, CreateBackup:=False
    Next
End With

newCSV.Close saveChanges:=False
    inputWb.Close saveChanges:=False

End Sub

Error highlighted from here according to "Debug":

Set inputWb = Workbooks.Open(inputFile)

Upvotes: 1

Views: 6133

Answers (2)

Scott Reilly
Scott Reilly

Reputation: 11

just change it to ActiveWorkbook unless your planning on running it for a different workbook then the one your using.

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

your problem is in the

inputFile = GetOpenFilename

Set inputWb = Workbooks.Open(inputFile)

your not telling it what the getopenfilename is

and there is no need to reopen

use the ACtiveWorkbook

Upvotes: 1

pnuts
pnuts

Reputation: 59475

I suggest you skip the GetOpenFilename option and go for the other one - be specific in this format: 

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

as detailed by John_w on MrExcel.com.

Upvotes: 0

Related Questions