KEMBAR78
Split The Rows Into Multiple Worksheets by Rows Count | PDF | Visual Basic For Applications | Microsoft Excel
Scribd
Upload
253 views3 pages

Split The Rows Into Multiple Worksheets by Rows Count

The document provides VBA code to split data in an Excel worksheet into multiple sheets based on a specified row count, with instructions for running the code to select a range and input the row count to split the range across new sheets placed after the original sheet. It also includes a sample VBA code to split a range into new workbooks based on a specified number of rows per file.

Uploaded by

Ahmed Atef Ismail
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
253 views3 pages

Split The Rows Into Multiple Worksheets by Rows Count

The document provides VBA code to split data in an Excel worksheet into multiple sheets based on a specified row count, with instructions for running the code to select a range and input the row count to split the range across new sheets placed after the original sheet. It also includes a sample VBA code to split a range into new workbooks based on a specified number of rows per file.

Uploaded by

Ahmed Atef Ismail
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 3

The following VBA code can help you split the rows into multiple worksheets by rows count, do

as follows:
1. Hold down the ALT + F11 key to open the Microsoft Visual Basic for Applications window.
2. Click Insert > Module, and paste the following code in the Module Window.
VBA: Split data into sheets by rows count in Excel.

1 Sub SplitData()
2 'Updateby20140617
3 Dim WorkRng As Range
4 Dim xRow As Range
5 Dim SplitRow As Integer
6 Dim xWs As Worksheet
7 On Error Resume Next
8 xTitleId = "KutoolsforExcel"
9 Set WorkRng = Application.Selection
1 Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address,
0 Type:=8)
SplitRow = Application.InputBox("Split Row Num", xTitleId, 5, Type:=1)
11
Set xWs = WorkRng.Parent
1
Set xRow = WorkRng.Rows(1)
2 Application.ScreenUpdating = False
1 For i = 1 To WorkRng.Rows.Count Step SplitRow
3
resizeCount = SplitRow
1
If (WorkRng.Rows.Count - xRow.Row + 1) < SplitRow Then resizeCount
4 = WorkRng.Rows.Count - xRow.Row + 1
xRow.Resize(resizeCount).Copy
1
Application.Worksheets.Add
5
after:=Application.Worksheets(Application.Worksheets.Count)
1
Application.ActiveSheet.Range("A1").PasteSpecial
6
Set xRow = xRow.Offset(SplitRow)
1 Next
7 Application.CutCopyMode = False
1 Application.ScreenUpdating = True
8 End Sub
1
9
2
0
2
1
2
2
2
3
2

4
2
5
3. Then press F5 key to run the code, and a dialog pops out for selecting a range to split, and
then click OK, and another dialog for you to specify the rows count. See screenshot:

4. Click OK, and the range are split into multiple sheets by the rows count.
Note: The split worksheets are placed at the back of the master worksheet.

Sub Test()
Dim wb As Workbook
Dim ThisSheet As Worksheet
Dim NumOfColumns As Integer
Dim RangeToCopy As Range
Dim RangeOfHeader As Range
'data (range) of header row
Dim WorkbookCounter As Integer
Dim RowsInFile
'how many rows (incl. header) in new files?
Application.ScreenUpdating = False
'Initialize data
Set ThisSheet = ThisWorkbook.ActiveSheet
NumOfColumns = ThisSheet.UsedRange.Columns.Count
WorkbookCounter = 1
RowsInFile = 10
'as your example, just 10 rows per file
'Copy the data of the first row (header)
Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1,
NumOfColumns))
For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1
Set wb = Workbooks.Add
'Paste the header row in new file
RangeOfHeader.Copy wb.Sheets(1).Range("A1")
'Paste the chunk of rows for this file
Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p +
RowsInFile - 2, NumOfColumns))
RangeToCopy.Copy wb.Sheets(1).Range("A2")
'Save the new workbook, and close it
wb.SaveAs ThisWorkbook.Path & "\test" & WorkbookCounter
wb.Close
'Increment file counter
WorkbookCounter = WorkbookCounter + 1

Next p
Application.ScreenUpdating = True
Set wb = Nothing
End Sub

You might also like