Split rows EQUALLY into multiple sheets

[Alberto15]

Hello all,
Trust you're good. I got this script from Kutools that allow me to split data into sheets. For example I need to split 1 sheet of 5000 rows into 5 sheets of 1000 rows. My issue is that when splitting the sheet, it decrease the rows by 1000 only (sheet 1 5000 rows, sheet 2 4000 rows, sheet 3 3000 rows). Instead of copying I tried to cut but I got blank excel then i tried to delete the exceeding rows and i got errors.

Grateful if you could help.

'split data into Sheets
Sub SplitDataIntoSheets()
Dim WorkRng As Range
Dim NumRow As Range
Dim SplitRow As Integer
Dim ws As Worksheet
On Error Resume Next

TitleID = "Distribution"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Press Ctrl A then modify $A$1 to $A$2", TitleID, WorkRng.Address, Type:=8)
SplitRow = Application.InputBox("Number of rows", TitleID, 800, Type:=1)
Set ws = WorkRng.Parent
Set NumRow = WorkRng.Rows(1)

Application.ScreenUpdating = False

For i = 1 To WorkRng.Rows.Count Step SplitRow
    resizeCount = SplitRow
    If (WorkRng.Rows.Count - xRow.Row + 1) < SplitRow Then resizeCount = WorkRng.Rows.Count - NumRow.Row + 1
    NumRow.Resize(resizeCount).Copy
    Application.Worksheets.Add after:=Application.Worksheets(Application.Worksheets.Count)
    Application.ActiveSheet.Range("A2").PasteSpecial
    Set NumRow = NumRow.Offset(SplitRow)
Next

Application.CutCopyMode = False
Application.ScreenUpdating = False
End Sub

 

[DanteAmor]

I need to split 1 sheet of 5000 rows into 5 sheets of 1000 rows.

Try the following, adjust n = 1000 for the desired number of lines.
Assuming your data starts in cell A2.
Run the macro on the sheet that you want to make the separation.

Sub splitData()
  Dim sh As Worksheet
  Dim i As Long, n As Long
  
  n = 1000
  Set sh = ActiveSheet
  For i = 2 To Range("A" & Rows.Count).End(3).Row Step n
    Sheets.Add , Sheets(Sheets.Count)
    sh.Range("A" & i).Resize(n).EntireRow.Copy Range("A2")
  Next
End Sub

 

[Alberto15]

Try the following, adjust n = 1000 for the desired number of lines.
Assuming your data starts in cell A2.
Run the macro on the sheet that you want to make the separation.

Sub splitData()
  Dim sh As Worksheet
  Dim i As Long, n As Long
 
  n = 1000
  Set sh = ActiveSheet
  For i = 2 To Range("A" & Rows.Count).End(3).Row Step n
    Sheets.Add , Sheets(Sheets.Count)
    sh.Range("A" & i).Resize(n).EntireRow.Copy Range("A2")
  Next
End Sub

Hello @DanteAmor ,Thanks for your response. Yes my cell will starts at A2 but the desired number will be dynamic as it will need to be adjusted depending on the situation.

 

[DanteAmor]

the desired number will be dynamic

You mean this:

Sub splitData()
  Dim sh As Worksheet
  Dim i As Long, n As Long
 
  n = Application.InputBox("Number of rows", "Distribution", 1000, Type:=1)
  If n = 0 Then Exit Sub
  Set sh = ActiveSheet
  For i = 2 To sh.Range("A" & Rows.Count).End(3).Row Step n
    Sheets.Add , Sheets(Sheets.Count)
    sh.Range("A" & i).Resize(n).EntireRow.Copy Range("A2")
  Next
End Sub

 

[Alberto15]

You mean this:

Sub splitData()
  Dim sh As Worksheet
  Dim i As Long, n As Long
 
  n = Application.InputBox("Number of rows", "Distribution", 1000, Type:=1)
  If n = 0 Then Exit Sub
  Set sh = ActiveSheet
  For i = 2 To sh.Range("A" & Rows.Count).End(3).Row Step n
    Sheets.Add , Sheets(Sheets.Count)
    sh.Range("A" & i).Resize(n).EntireRow.Copy Range("A2")
  Next
End Sub

when executing, I got empty sheets

 

[DanteAmor]

Check the data on your sheet, in column A, maybe you have blank spaces inside the cells.
Or do you have formulas in column A?

 

[My Aswer Is This]

when executing, I got empty sheets

I tried the script and it worked for me.

I suspect you had some empty sheets to begin with.
The script adds new sheets and puts your scripts data in the new sheets.

 

[Alberto15]

I still got empty sheets and I don't have empty sheets nor empty spaces.. I tried on other sheets but still the same, on both .csv and .xlxs. here is the minisheet...

test1.xlsx
	A	B	C	D	E	F
1	Name1	Test1	office1	Address1	Address2	Address3
2	Name22	Test22	office22	Address22	Address23	Address24
3	Name23	Test23	office23	Address23	Address24	Address25
4	Name24	Test24	office24	Address24	Address25	Address26
5	Name25	Test25	office25	Address25	Address26	Address27
6	Name26	Test26	office26	Address26	Address27	Address28
7	Name27	Test27	office27	Address27	Address28	Address29
8	Name28	Test28	office28	Address28	Address29	Address30
9	Name29	Test29	office29	Address29	Address30	Address31
10	Name30	Test30	office30	Address30	Address31	Address32
11	Name31	Test31	office31	Address31	Address32	Address33
12	Name32	Test32	office32	Address32	Address33	Address34
13	Name33	Test33	office33	Address33	Address34	Address35
14	Name34	Test34	office34	Address34	Address35	Address36
15	Name35	Test35	office35	Address35	Address36	Address37
16	Name36	Test36	office36	Address36	Address37	Address38
17	Name37	Test37	office37	Address37	Address38	Address39
18	Name38	Test38	office38	Address38	Address39	Address40
19	Name39	Test39	office39	Address39	Address40	Address41
20	Name40	Test40	office40	Address40	Address41	Address42
21	Name41	Test41	office41	Address41	Address42	Address43
22	Name22	Test22	office22	Address22	Address23	Address24
23	Name23	Test23	office23	Address23	Address24	Address25
24	Name24	Test24	office24	Address24	Address25	Address26
25	Name25	Test25	office25	Address25	Address26	Address27
26	Name26	Test26	office26	Address26	Address27	Address28
27	Name27	Test27	office27	Address27	Address28	Address29
28	Name28	Test28	office28	Address28	Address29	Address30
29	Name29	Test29	office29	Address29	Address30	Address31
30	Name30	Test30	office30	Address30	Address31	Address32
31	Name31	Test31	office31	Address31	Address32	Address33
32	Name32	Test32	office32	Address32	Address33	Address34
33	Name33	Test33	office33	Address33	Address34	Address35
34	Name34	Test34	office34	Address34	Address35	Address36
35	Name35	Test35	office35	Address35	Address36	Address37
36	Name36	Test36	office36	Address36	Address37	Address38
37	Name37	Test37	office37	Address37	Address38	Address39
38	Name38	Test38	office38	Address38	Address39	Address40
39	Name39	Test39	office39	Address39	Address40	Address41
40	Name40	Test40	office40	Address40	Address41	Address42
41	Name41	Test41	office41	Address41	Address42	Address43
Sheet1

 

[DanteAmor]

In your example, there are only 41 records. If you go to cell A41 and press the End key and then the down arrow, where does the cursor stop.

 

[Alberto15]

In your example, there are only 41 records. If you go to cell A41 and press the End key and then the down arrow, where does the cursor stop.

It stops at 1001, then I copied to 41 rows to test on a new sheets as

n = Application.InputBox("Number of rows", "Distribution", 1000, Type:=1)

can be modified and easy to work with.
I keep on trying and I'm stuck.