Split Excel File Into Multiple Excel Files, Based on Number of Rows

Let's assume you have an Excel Spreadsheet with 30000 rows in it and you need to split it into individual Spreadsheets with 3000 rows each. You can do this by creating a VBA Script and execute it from the Excel VBA Editor.

Here's the code (*):

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43

Sub SplitMyFile() 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 ' Set here the row limit RowsInFile = 3000 ' 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

(*) Found on Stack Overflow