Split excel workbook into several files with fewer rows

splitting_excel_workbook.md

I faced some difficulty in splitting a large Excel file into several smaller ones with fewer rows. Here is a quick solutions for the same:

Open file to split -> Developer menu -> Visual Basic menu -> Insert menu -> new module submenu -> paste the following code and click on green run button.

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 = 300                   'as your example, just 300 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 & "/TargetFiles/TargetFile" & WorkbookCounter & ".xlsx"
    wb.Close
    
  'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub