How to split 1 excel file to multipe file

[Poliptm]

I have large excel file with more than 20.000 rows
I want to seperate every 700 row with same header and formula, and save as to a new file with name like this “file1-700”, “file701-1400”. until end of row,

Any help would be great, really apreciate it

 

[earthworm]

Try this macro

Sub Split_data_into_700()

' This macro is created by earthworm

Dim y As Integer

For y = 1 To Range("H4").Value

    Range("A" & 700 * y - 700 + 2 & ":E" & 700 * y + 1).Select  ' A-E is the selected range increase as per your requirement
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Workbooks.Add
    Range("A2").Select
    ActiveSheet.Paste
    ChDir "C:\Users\Test\Desktop\Test" ' Change Test to windows username
   
    'Change below Test to Windows Username
    ActiveWorkbook.SaveAs Filename:="C:\Users\Test\Desktop\Test\" & y & ".xlsx", _
    FileFormat:=xlOpenXMLWorkbook
   
   
    Windows("Roaster.xlsb").Activate ' Change Filename to your main file name
    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Range("A1:E1").Copy
    Windows(y & ".xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
     
        Next y
     
End Sub

 

[earthworm]

This is main file

Roaster.xlsb
	A	B	C	D	E	F	G	H	I	J
1	S.no	Headers 1	Headers 2	Headers 3	Headers 4					700
2	1						Insert Data Length	20,000		1
3	2						Insert Split Length	700		701
4	3						Total Files	28		1401
5	4
6	5
7	6
8	7
9	8
10	9
11	10
12	11
13	12
Sheet1

Cell Formulas
Range	Formula
H4	H4	=INT(H2/H3)

 

[Marc L]

A VBA demonstration for starters :​

Sub Demo1()
  Const L = 700
    Dim Rw As Range, F$, P$, R&
    Set Rw = ActiveSheet.UsedRange.Rows
         F = String$(Len(CStr(Rw.Count)), "0")
         P = ActiveWorkbook.Path & "\File"
         R = 2
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .SheetsInNewWorkbook = 1
    With Workbooks.Add.Sheets(1)
         Rw(1).Copy .[A1]
    While R <= Rw.Count
         Rw(R).Resize(L).Copy .[A2]
        .Parent.SaveAs P & Format(R, F) & "-" & Format(Application.Min(R + L - 1, Rw.Count), F), 51
         R = R + L
    Wend
        .Parent.Close False
    End With
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
        Set Rw = Nothing
End Sub

 

[Poliptm]

it doesnt run, when i use it, it not function, not getting any message, not hapen

 

[Marc L]

not getting any message

So my demonstration obviously works as expected like on my side …​

 

[Fluff]

it doesnt run, when i use it, it not function, not getting any message, not hapen

As two people have supplied code, it would help if you said which code you were referring to.