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.

 

[byoungman]

Is there a modification to keep the original formatting?

 

[MoshiM]

Is there a modification to keep the original formatting?

Use FileFormat:= Thisworkbook.fileformat

 

[MoshiM]

Hello all - this code works like charm. But i do have following requirement and some challenges.

1) am planning to split thr files by 1 lakh records. I tried testing this formula for 7 lakh records and it's working like charm. But the issue is, its not working for a case when the rows are less than 1 lakh records. What happens is it splits the first file with available total records but then the file split still continues with header only. I am not sure where I went wrong. What i want is if the file records are less than 1 lakh, then the file split should be just one file.
2) I would want a button and provide user to select the file to split. Once the user selects the file, then the splitting of files by 1 lakh records happens

Can some please help..

I tried many places but not able to reach anywhere...

Please help

try replacing the range assignment near the top with

With ThisWorkbook.ActiveSheet
    Set ACS = .Range(.Cells(1, 1), .Cells(.Rows.Count, .UsedRange.Columns.Count).End(xlUp))
End With

 

[MoshiM]

Use FileFormat:= Thisworkbook.fileformat

You will also have to change the ".xls" in

ACS.Parent.Parent.Path & Application.PathSeparator & "file-" & Z & ".xls"

so that it matches the output format.

 

[CXOasis]

Hi thanks for this code, Is it possible to edit the code so it saves in xlxs format and also keep the sheet names the same as the original, At the moment it names them sheet 1.

 

[MoshiM]

Hi thanks for this code, Is it possible to edit the code so it saves in xlxs format and also keep the sheet names the same as the original, At the moment it names them sheet 1.

Sub flyguy()
Dim Source_RNG 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,file_type_str as string,file_format_number as long,source_sheet_name as string,rows_per_file as long

With ThisWorkbook.ActiveSheet
    source_sheet_name=.name
    Set Source_RNG = .Range(.Cells(1, 1), .Cells(.Rows.Count, .UsedRange.Columns.Count).End(xlUp))
End With

file_type_str=".xlsx"
file_format_number=xlOpenXMLStrictWorkbook
rows_per_file=500

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

Start_Row = 2

Do While Stop_Row <= Source_RNG.Rows.Count
  
    Z = Z + 1
  
    If Z > 1 Then Start_Row = Stop_Row + 1
  
    Stop_Row = Start_Row + (rows_per_file-1)
  
    With Source_RNG.Rows
        If Stop_Row > .Count Then Stop_Row = .Count
    End With
  
    With Source_RNG
        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
            .name= source_sheet_name
        End With
      
       .SaveAs Source_RNG.Parent.Parent.Path & Application.PathSeparator & "file-" & Z & file_type_str, FileFormat:=file_format_number
       .Close
     
    End With
  
    If Stop_Row = Source_RNG.Rows.Count Then Exit Do
  
Loop
End Sub

 

[MoshiM]

Hi thanks for this code, Is it possible to edit the code so it saves in xlxs format and also keep the sheet names the same as the original, At the moment it names them sheet 1.

I just realized that you are on MAC. Try looking at post #19

 

[amyschneider]

Hello. This code has worked great for my 500K line worksheet. One question: My original file has a hyperlink in it. When the file splits and saves, the hyperlink no longer works. How do I fix this exactly?

 

[MoshiM]

Hello. This code has worked great for my 500K line worksheet. One question: My original file has a hyperlink in it. When the file splits and saves, the hyperlink no longer works. How do I fix this exactly?

Try changing

.Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns) = Copied_Range.Value

to

Copied_Range.copy
.Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns).PasteSpecial xlPasteAll

Then add Application.CutCopyMode = False before the end sub at the end

 

[Gaurav_Singh]

Code showing error Run-time error "13", Type Mismatch