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

[flyguy]

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.

 

[MoshiM]

Make the worksheet with the data the active sheet and run this. It should save to the same path as the csv.

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

 

[flyguy]

Make the worksheet with the data the active sheet and run this. It should save to the same path as the csv.

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]

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]

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]

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

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]

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

 

[flyguy]

The new code

Getting an error and the below text is red


Dim ACS As Range, Z As Long, New_WB As Workbook, B As Long, _

 

[MoshiM]

Getting an error and the below text is red


Dim ACS As Range, Z As Long, New_WB As Workbook, B As Long, _

add a space after the last comma

 

[flyguy]

add a space after the last comma

did that and get compile error and Sub flyguy() is yellow
Sub flyguy()




Dim ACS As Range, Z As Long, New_WB As Workbook, B As Long, _