Looking to split a large excel file by rows and keep the header

flyguy

New Member
Joined
Dec 24, 2020
Messages
8
Platform
  1. Windows
I am trying to split up an excel file that has multiple lines, I want to break this into groups of 500 lines and retain the original header info for each file. This file will always have the same header just different amount of lines each time. Is this possible to do with a macro/vba. I have no real experience with macros for programming. It would be great if it could auto save as file1-file2 etc. file name does not matter. Just breaking apart manually is time consuming and looking to see if it can be automated.
The file starts as a .csv and needs to be converted to an .xls

Thank you for your assistance.
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

MoshiM

Active Member
Joined
Jan 31, 2018
Messages
371
Office Version
  1. 2016
Platform
  1. Windows
Make the worksheet with the data the active sheet and run this. It should save to the same path as the csv.
VBA Code:
Sub flyguy()

Dim ACS As Range, Z As Long, New_WB As Workbook, _
Total_Columns As Long, Start_Row As Long, Stop_Row As Long, Copied_Range As Range

Dim Headers() As Variant

Set ACS = ActiveSheet.UsedRange

With ACS

    Headers = .Rows(1).Value
    Total_Columns = .Columns.Count
    
End With

Start_Row = 2

Do While Stop_Row <= ACS.Rows.Count
    
    Z = Z + 1
    
    If Z > 1 Then Start_Row = Stop_Row + 1
    
    Stop_Row = Start_Row + 499
    
    With ACS.Rows
        If Stop_Row > .Count Then Stop_Row = .Count
    End With
    
    With ACS
        Set Copied_Range = .Range(.Cells(Start_Row, 1), .Cells(Stop_Row, Total_Columns))
    End With
    
    Set New_WB = Workbooks.Add
    
    With New_WB
    
        With .Worksheets(1)
            .Cells(1, 1).Resize(1, Total_Columns) = Headers
            .Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns) = Copied_Range.Value
        End With
        
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & "file-" & Z & ".xls", FileFormat:=-4143
       .Close
       
    End With
    
    If Stop_Row = ACS.Rows.Count Then Exit Do
    
Loop

End Sub
 
Solution

flyguy

New Member
Joined
Dec 24, 2020
Messages
8
Platform
  1. Windows
Make the worksheet with the data the active sheet and run this. It should save to the same path as the csv.
VBA Code:
Sub flyguy()

Dim ACS As Range, Z As Long, New_WB As Workbook, _
Total_Columns As Long, Start_Row As Long, Stop_Row As Long, Copied_Range As Range

Dim Headers() As Variant

Set ACS = ActiveSheet.UsedRange

With ACS

    Headers = .Rows(1).Value
    Total_Columns = .Columns.Count
   
End With

Start_Row = 2

Do While Stop_Row <= ACS.Rows.Count
   
    Z = Z + 1
   
    If Z > 1 Then Start_Row = Stop_Row + 1
   
    Stop_Row = Start_Row + 499
   
    With ACS.Rows
        If Stop_Row > .Count Then Stop_Row = .Count
    End With
   
    With ACS
        Set Copied_Range = .Range(.Cells(Start_Row, 1), .Cells(Stop_Row, Total_Columns))
    End With
   
    Set New_WB = Workbooks.Add
   
    With New_WB
   
        With .Worksheets(1)
            .Cells(1, 1).Resize(1, Total_Columns) = Headers
            .Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns) = Copied_Range.Value
        End With
       
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & "file-" & Z & ".xls", FileFormat:=-4143
       .Close
      
    End With
   
    If Stop_Row = ACS.Rows.Count Then Exit Do
   
Loop

End Sub
This is Fantastik!! Thank you so much!!! I have ran a quick test on this and it seems to do exactly what I was looking for in the blink of an eye. Is there a way to save this so every time I open excel I do not have to copy/paste into the module? Will run some more tests after the holiday. I never knew excel was this powerful.
 

MoshiM

Active Member
Joined
Jan 31, 2018
Messages
371
Office Version
  1. 2016
Platform
  1. Windows
This is Fantastik!! Thank you so much!!! I have ran a quick test on this and it seems to do exactly what I was looking for in the blink of an eye. Is there a way to save this so every time I open excel I do not have to copy/paste into the module? Will run some more tests after the holiday. I never knew excel was this powerful.
You can place it inside a module in the Personal workbook and run it from there.
 

flyguy

New Member
Joined
Dec 24, 2020
Messages
8
Platform
  1. Windows

ADVERTISEMENT

You can place it inside a module in the Personal workbook and run it from there.
Placing it there worked as expected thank you.
One additional question. After I run the macro the first time the files are created as expected, File-1,File-2,File-3 etc. If I get another file and try to run the macro it does not create a new file with an increase the file names such as File-4, File-5 it says --A file name already exists in this location do you want to overwrite it(looks to be putting in in the same location as the first File-1)
Is there a workaround for this? Can the file naming just continue?
If I hit no When I debug the below is highlighted
.SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & "file-" & Z & ".xls", FileFormat:=-4143
 

MoshiM

Active Member
Joined
Jan 31, 2018
Messages
371
Office Version
  1. 2016
Platform
  1. Windows
Placing it there worked as expected thank you.
One additional question. After I run the macro the first time the files are created as expected, File-1,File-2,File-3 etc. If I get another file and try to run the macro it does not create a new file with an increase the file names such as File-4, File-5 it says --A file name already exists in this location do you want to overwrite it(looks to be putting in in the same location as the first File-1)
Is there a workaround for this? Can the file naming just continue?
If I hit no When I debug the below is highlighted
.SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & "file-" & Z & ".xls", FileFormat:=-4143
VBA Code:
Sub flyguy()

Dim ACS As Range, Z As Long, New_WB As Workbook, B As Long, _
Total_Columns As Long, Start_Row As Long, Stop_Row As Long, Copied_Range As Range, File_Name As String

Dim Headers() As Variant

Set ACS = ActiveSheet.UsedRange

With ACS
    Headers = .Rows(1).Value
    Total_Columns = .Columns.Count
End With

File_Name = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.xls")

On Error GoTo Next_File

Do While Len(File_Name) > 0

    If File_Name Like "*file-*" Then
    
        B = CLng(Split(Split(File_Name, "file-")(1), ".xls")(0))
        
        If B > Z Then Z = B
    
    End If
    
Next_File: On Error GoTo -1
    
    File_Name = Dir
    
Loop

On Error GoTo 0

Start_Row = 2

Do While Stop_Row <= ACS.Rows.Count
    
    Z = Z + 1
    
    If Z > 1 Then Start_Row = Stop_Row + 1
    
    Stop_Row = Start_Row + 499
    
    With ACS.Rows
        If Stop_Row > .Count Then Stop_Row = .Count
    End With
    
    With ACS
        Set Copied_Range = .Range(.Cells(Start_Row, 1), .Cells(Stop_Row, Total_Columns))
    End With
    
    Set New_WB = Workbooks.Add
    
    With New_WB
    
        With .Worksheets(1)
            .Cells(1, 1).Resize(1, Total_Columns) = Headers
            .Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns) = Copied_Range.Value
        End With
        
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & "file-" & Z & ".xls", FileFormat:=-4143
       .Close
       
    End With
    
    If Stop_Row = ACS.Rows.Count Then Exit Do
    
Loop

End Sub
 

flyguy

New Member
Joined
Dec 24, 2020
Messages
8
Platform
  1. Windows

ADVERTISEMENT

VBA Code:
Sub flyguy()

Dim ACS As Range, Z As Long, New_WB As Workbook, B As Long, _
Total_Columns As Long, Start_Row As Long, Stop_Row As Long, Copied_Range As Range, File_Name As String

Dim Headers() As Variant

Set ACS = ActiveSheet.UsedRange

With ACS
    Headers = .Rows(1).Value
    Total_Columns = .Columns.Count
End With

File_Name = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.xls")

On Error GoTo Next_File

Do While Len(File_Name) > 0

    If File_Name Like "*file-*" Then
   
        B = CLng(Split(Split(File_Name, "file-")(1), ".xls")(0))
       
        If B > Z Then Z = B
   
    End If
   
Next_File: On Error GoTo -1
   
    File_Name = Dir
   
Loop

On Error GoTo 0

Start_Row = 2

Do While Stop_Row <= ACS.Rows.Count
   
    Z = Z + 1
   
    If Z > 1 Then Start_Row = Stop_Row + 1
   
    Stop_Row = Start_Row + 499
   
    With ACS.Rows
        If Stop_Row > .Count Then Stop_Row = .Count
    End With
   
    With ACS
        Set Copied_Range = .Range(.Cells(Start_Row, 1), .Cells(Stop_Row, Total_Columns))
    End With
   
    Set New_WB = Workbooks.Add
   
    With New_WB
   
        With .Worksheets(1)
            .Cells(1, 1).Resize(1, Total_Columns) = Headers
            .Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns) = Copied_Range.Value
        End With
       
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & "file-" & Z & ".xls", FileFormat:=-4143
       .Close
      
    End With
   
    If Stop_Row = ACS.Rows.Count Then Exit Do
   
Loop

End Sub
The new code
 

Watch MrExcel Video

Forum statistics

Threads
1,127,611
Messages
5,625,822
Members
416,138
Latest member
Pizzaman22

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top