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]

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

With a value of 1000, how many blank sheets does it generate?

You can share your book with the macro to review it.
You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[Alberto15]

With a value of 1000, how many blank sheets does it generate?

You can share your book with the macro to review it.
You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

I chose 1000 then it split to 10, then tested with 5000 and split to 2 sheets. for the splitting it is ok but the distribution on the other sheets, that's my issue.

here is the link for the gdrive, i put generic data into it: Test.csv
thanks for your help

 

[Marc L]

Hi,​

​

starting from the csv text file so well elaborate at least what should be done !​

Like where to import this file, in a new workbook or in the workbook containing the VBA import procedure …​

The better explanation, the more targeted solution.​

 

[Alberto15]

Hi,​

​

starting from the csv text file so well elaborate at least what should be done !​

Like where to import this file, in a new workbook or in the workbook containing the VBA import procedure …​

The better explanation, the more targeted solution.​

the file should be distributed in new worksheets. the script will be save in a module

 

[Marc L]

Any other information ? That means your are very confident with your Excel / VBA skills to fit any code from some forum helper !​

 

[Marc L]

According to the post #12 attachment - which must be in the same folder as the workbook - a VBA demonstration for starters :​

Sub Demo1()
    Dim C$, L&, V, P&, S&, T$(), N&, R&, K&
        C = ThisWorkbook.Path & "\Test.csv":  If Dir(C) = "" Then Beep: Exit Sub
        L = FreeFile
        Open C For Input As #L
        V = Split(Input(LOF(L), #L), vbCrLf)
        Close #L
        L = UBound(V) + (V(UBound(V)) = "")
        C = InputBox(vbLf & " This text file has " & Format(L, "# ###") & " lines of data …" & _
                     vbLf & vbLf & " … to split into how many worksheets :", C)
    If Val(C) > 1 Then
        P = Sheets.Count
        S = Round(L / C)
        ReDim T(S + 1, 0):  T(0, 0) = V(0)
        Application.ScreenUpdating = False
        Sheets.Add , Sheets(P), C
    For N = 1 To C
        If N = C Then S = L Else L = L - S
        For R = 1 To S:  T(R, 0) = V(K + R):  Next
    With Sheets(P + N).[A1].Resize(R)
        .Value2 = T
        .TextToColumns , 1, , , , , True
        .CurrentRegion.Columns.AutoFit
    End With
        K = K + S
    Next
        Application.ScreenUpdating = True
    End If
End Sub