Macro to Split Excel File in Multiple .csv files every 5000 lines

[borjasanz]

Hello guys.

I need help with a macro that achieves this: I have files with over 15,000/20,000 lines that are supposed to be uploaded to the system in independent 5000 line .csv files to the SAP system.

However, I have no idea how to do this. I've thought about it and really can't think of any solution via VBA.

Please I need your help! Files have a variable number of lines every day and it takes a lot of time to split them daily and manually.

I also need files to be named this way, imagine the original file is named ABCDE.xlsx, I would need the new files to be named ABCDE(1).csv, ABCDE(2).csv, ABCDE(3).csv, etc. depending on how many lines the file has. The last file can have less than 5,000 lines; just the maximum number has to be 5000.

 

[John_w]

Try this:

Public Sub Split_5000()

    Dim inputFile As String, inputWb As Workbook
    Dim lastRow As Long, row As Long, n As Long
    Dim newCSV As Workbook
    
    inputFile = "C:\Path\To\ABCDE.xlsx"           'CHANGE TO YOUR INPUT FILE, OR USE 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 = 1 To lastRow Step 5000
            n = n + 1
            .Rows(row & ":" & row + 5000 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A1")
            
            '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

 

[Southerncentralrain]

This would work perfect for me but I need to keep the header on all pages. Any idea how to do this?

 

[John_w]

Try this:

Public Sub Split_5000_With_Column_Headings()

    Dim inputFile As String, inputWb As Workbook
    Dim lastRow As Long, row As Long, n As Long
    Dim newCSV As Workbook
    
    inputFile = "C:\Path\To\ABCDE.xlsx"           'CHANGE TO YOUR INPUT FILE, OR USE 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

 

[Southerncentralrain]

This is great. Thanks so much. Is there a way to save this as .xlsx files?

Thanks again for your time.

 

[Southerncentralrain]

Actually, I figured that out. However, I would like for it to delete the original file after it produces the smaller file

 

[Southerncentralrain]

I just realized that my post was cut off. Is is possible to delete the original file after the macro produces the smaller files?

 

[John_w]

Try the Kill command.

 

[aziz_khan]

Thanks John_W!!!!

Is there any way that I can save the files to the different folder paths in a range?

I am sorry but if this does not make sense but What I am actually looking for is

Input1 gets saved to C:\Users\Aziz\Desktop\New folder
Input2 gets saved to C:\Users\Aziz\Desktop\New folder1
Input3 gets saved to C:\Users\Aziz\Desktop\New folder2
Input4 gets saved to C:\Users\Aziz\Desktop\New folder3
Input5 gets saved to C:\Users\Aziz\Desktop\New folder4
Input6 gets saved to C:\Users\Aziz\Desktop\New folder5
Input7 gets saved to C:\Users\Aziz\Desktop\New folder6
Input8 gets saved to C:\Users\Aziz\Desktop\New folder7
Input9 gets saved to C:\Users\Aziz\Desktop\New folder8
Input10 gets saved to C:\Users\Aziz\Desktop\New folder9

 

[John_w]

Which range? The code creates multiple output files, not input files. Assuming you mean output files, and coding according to the second part of your post, try this:

Public Sub Split_5000_With_Column_Headings_Save_In_Folders()

    Dim inputFile As String, inputWb As Workbook
    Dim lastRow As Long, row As Long, n As Long
    Dim newCSV As Workbook
    Dim mainFolder As String, saveSubfolder As String
    
    inputFile = "C:\Path\To\ABCDE.xls"           'CHANGE TO YOUR INPUT FILE, OR USE GETOPENFILENAME
    
    mainFolder = "C:\Users\Aziz\Desktop\"        'MAIN FOLDER IN WHICH 'New foldern' SUBFOLDERS ARE CREATED AND .CSV FILES ARE SAVED
    If Right(mainFolder, 1) <> "\" Then mainFolder = mainFolder & "\"
    
    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")
            
            saveSubfolder = mainFolder & "New folder" & n & "\"
            On Error Resume Next
            MkDir saveSubfolder
            On Error GoTo 0
            
            'Save in 'New foldern' subfolder with .xls replaced by (n).csv
            newCSV.SaveAs Filename:=saveSubfolder & Replace(inputWb.Name, ".xls", "(" & n & ").csv"), FileFormat:=xlCSV, CreateBackup:=False
        Next
    End With
    
    newCSV.Close saveChanges:=False
    inputWb.Close saveChanges:=False
    
End Sub