Split an Excel sheet into N number of distinct workbook

[Tanu]

How we can write a VBA code for spilt an excel sheet into multiple workbooks if it contains lakhs of records...for eg - we have 10k records in master sheet now we want 2 workbook of 5k-5k chunks then how we can automatically do this
Or if I give 4 as a number for 10k records then it should divide it & validate it and spilts the workbook accordingly

 

[mohadin]

.Cells(1, 1).Resize(,3) = h

 

[Tanu]

.Cells(1, 1).Resize(,3) = h

.Cells(1, 1).Resize(,3) = h

This is not working
Could you plz provide the whole soln!
It will be helpful.
Thankyou so much in advance

 

[mohadin]

Hi
The code in post#7
If it's not what you want please elaborate your needs

 

[Tanu]

Hi
The code in post#7
If it's not what you want please elaborate your nee

Actually if there is 2 header in a master sheet then it should copy those 2 headers in each workbook...

 

[Tanu]

Actually if there is 2 header in a master sheet then it should copy those 2 headers in each workbook...

Can we make a change in this code
Like I'm browsing a file through VBA and I want this code should check that workbook which we have browsed and accordingly it splits

 

[mohadin]

Sub test()
Dim a, x
Dim i&, n&, c&
Dim Myfile As Variant
Dim p As String
Myfile = Application.GetOpenFilename()
If Myfile = False Then Exit Sub
Workbooks.Open Myfile
p = ActiveWorkbook.path
a = Sheets("sheet1").Cells(1, 1).CurrentRegion
n = InputBox("HOW MANY WORKBOOKS?")
x = Application.RoundUp((UBound(a) / n), 0)
Application.ScreenUpdating = False
For i = 1 To n
        Workbooks.Add
            With ActiveSheet
                .Cells(1, 1).Resize(x, UBound(a, 2)) = Application.IfError(Application.Transpose( _
                            Application.Index(a, Application.Transpose(Evaluate("row(" _
                                            & c + 1 & ":" & c + x & ")")), Evaluate("row(1:" & UBound(a, 2) & ")"))), "")
                            c = c + x
                ActiveWorkbook.SaveAs fileName:=p & "\Test_" & i & ".xlsx"
                ActiveWorkbook.Close SaveChanges:=True
End With
Next
 ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

 

[Tanu]

Sub test()
Dim a, x
Dim i&, n&, c&
Dim Myfile As Variant
Dim p As String
Myfile = Application.GetOpenFilename()
If Myfile = False Then Exit Sub
Workbooks.Open Myfile
p = ActiveWorkbook.path
a = Sheets("sheet1").Cells(1, 1).CurrentRegion
n = InputBox("HOW MANY WORKBOOKS?")
x = Application.RoundUp((UBound(a) / n), 0)
Application.ScreenUpdating = False
For i = 1 To n
        Workbooks.Add
            With ActiveSheet
                .Cells(1, 1).Resize(x, UBound(a, 2)) = Application.IfError(Application.Transpose( _
                            Application.Index(a, Application.Transpose(Evaluate("row(" _
                                            & c + 1 & ":" & c + x & ")")), Evaluate("row(1:" & UBound(a, 2) & ")"))), "")
                            c = c + x
                ActiveWorkbook.SaveAs fileName:=p & "\Test_" & i & ".xlsx"
                ActiveWorkbook.Close SaveChanges:=True
End With
Next
 ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

This is perfect thankyou so much
A last query can we make the workbook name as dynamic instead of test it reads current workbook name and update the splits workbook accordingly

 

[mohadin]

Hi
What about

Sub test()
Dim a, x, h
Dim i&, n&, c&
Dim Myfile As Variant
Dim p, nm As String
Myfile = Application.GetOpenFilename()
If Myfile = False Then Exit Sub
Workbooks.Open Myfile
p = ActiveWorkbook.path
nm = Split(ActiveWorkbook.Name, ".")(0)
a = Sheets("sheet1").Cells(1, 1).CurrentRegion
h = Sheets("sheet1").Cells(1, 1).CurrentRegion.Resize(1)
n = InputBox("HOW MANY WORKBOOKS?")
x = Application.RoundUp((UBound(a) / n), 0)
c = 1
Application.ScreenUpdating = False
For i = 1 To n
        Workbooks.Add
            With ActiveSheet
                .Cells(1, 1).Resize(, 2) = h
                .Cells(2, 1).Resize(x, UBound(a, 2)) = Application.IfError(Application.Transpose( _
                            Application.Index(a, Application.Transpose(Evaluate("row(" _
                                            & c + 1 & ":" & c + x & ")")), Evaluate("row(1:" & UBound(a, 2) & ")"))), "")
                            c = c + x
                ActiveWorkbook.SaveAs fileName:=p & "\" & nm & i & ".xlsx"
                ActiveWorkbook.Close SaveChanges:=True
End With
Next
 ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

 

[James006]

@ mohadin

All my Congratulations ... for your Immeasurable Patience

 

[Tanu]

@ mohadin

All my Congratulations ... for your Immeasurable Patience

Thankyou soo much!!