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

 

[James006]

Hi,

A fairly simple macro can filter the master worksheet and create a distinct workbook for each result.

 

[mohadin]

HI
What about

Sub test()
Dim a, x
Dim i&, n&, c&
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:=ThisWorkbook.Path & "\" & i & ".xlsx"
                ActiveWorkbook.Close SaveChanges:=True
End With
Next
Application.ScreenUpdating = True
End Sub

 

[Tanu]

HI
What about

Sub test()
Dim a, x
Dim i&, n&, c&
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:=ThisWorkbook.Path & "\" & i & ".xlsx"
                ActiveWorkbook.Close SaveChanges:=True
End With
Next
Application.ScreenUpdating = True
End Sub

Can you plz add a code that each workbook having the header from master sheet as well

 

[Tanu]

HI
What about

Sub test()
Dim a, x
Dim i&, n&, c&
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:=ThisWorkbook.Path & "\" & i & ".xlsx"
                ActiveWorkbook.Close SaveChanges:=True
End With
Next
Application.ScreenUpdating = True
End Sub

And also add a code when it splits into multiple then name should be test_1,test_2 like that

 

[mohadin]

And also add a code when it splits into multiple then name should be test_1,test_2 like that

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\test_" & i & ".xlsx"

 

[mohadin]

Ah sorry
Try

Sub test()
Dim a, x, h
Dim i&, n&, c&
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(, UBound(a, 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:=ThisWorkbook.Path & "\Test_" & i & ".xlsx"
                ActiveWorkbook.Close SaveChanges:=True
End With
Next
Application.ScreenUpdating = True
End Sub

 

[Tanu]

Ah sorry
Try

Sub test()
Dim a, x, h
Dim i&, n&, c&
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(, UBound(a, 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:=ThisWorkbook.Path & "\Test_" & i & ".xlsx"
                ActiveWorkbook.Close SaveChanges:=True
End With
Next
Application.ScreenUpdating = True
End Sub

 

[mohadin]

???
Any thing!

 

[Tanu]

If more then 3 header and we want those 3 header in each workbook then which line should we modify ?

???
Any thing!