How can I split a large excel file into multiple smaller files?

How to split excel file into multiple files by row?

Sub Test()
  Dim wbook As Workbook
  Dim tsheet As Worksheet
  Dim nOfColumns As Integer
  Dim rtcopy As Range
  Dim rofheader As Range        'data-range of header row
  Dim wbcounter As Integer
  Dim rinfile                    'how many rows in new files?

  Application.ScreenUpdating = False

  'Initial data
  Set tsheet = ThisWorkbook.ActiveSheet
  nOfColumns = tsheet.UsedRange.Columns.Count
  wbcounter = 1
  rinfile = 10                   'enter how many rows

  'Copy data from the first header row
  Set rofheader = tsheet.Range(tsheet.Cells(1, 1), tsheet.Cells(1, nOfColumns))

  For p = 2 To tsheet.UsedRange.Rows.Count Step rinfile - 1
    Set wbook = Workbooks.Add

    'Paste the header rows in newfile
    rofheader.Copy wbook.Sheets(1).Range("A1")

    'Paste the chunk of rows
    Set rtcopy = tsheet.Range(tsheet.Cells(p, 1), tsheet.Cells(p + rinfile - 2, nOfColumns))
    rtcopy.Copy wbook.Sheets(1).Range("A2")

    'Save the new workbook
    wbook.SaveAs ThisWorkbook.Path & "\test" & wbcounter
    wbook.Close

    'Increment count
    wbcounter = wbcounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wbook = Nothing
End Sub

How can I split a large excel file into multiple smaller files? or How to split one excel sheet into multiple files using a macro?

'How can I split a large excel file into multiple smaller files?
Sub Test()
  Dim wbook As Workbook
  Dim tsheet As Worksheet
  Dim nOfColumns As Integer
  Dim rtcopy As Range
  Dim wbcounter As Integer
  Dim rinfile
  Dim pfix As String
  Application.ScreenUpdating = False
  'Initial work data
  Set tsheet = ThisWorkbook.ActiveSheet
  nOfColumns = tsheet.UsedRange.Columns.Count
  wbcounter = 1
  rinfile = 100                   'how many rows in new files?
  pfix = "test"                    'pfix of the file name
  For p = 1 To tsheet.UsedRange.Rows.Count Step rinfile
    Set wbook = Workbooks.Add
    'Paste the chunk of rows
    Set rtcopy = tsheet.Range(tsheet.Cells(p, 1), tsheet.Cells(p + rinfile - 1, nOfColumns))
    rtcopy.Copy wbook.Sheets(1).Range("A1")
    'Save the new workbook
    wbook.SaveAs ThisWorkbook.Path & "\" & pfix & "_" & wbcounter
    wbook.Close
    'Increment file count
    wbcounter = wbcounter + 1
  Next p
  Application.ScreenUpdating = True
  Set wbook = Nothing
End Sub

How to split each sheet into a separate Excel file?

Sub Test()
Dim filepath As String
filepath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
    ws.Copy
    Application.ActiveWorkbook.SaveAs Filename:=filepath & "\" & ws.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

How to split excel sheet into multiple files based on column?

Sub Test()
'Export value in the columns
    Dim sheetcells As Range
    Dim allsheets As Worksheet
    Dim nam As String
    Dim cellsarea As Range
    Dim allsname As String
    Dim kcolums As String
    Dim fields As Integer
    allsname = ActiveSheet.Name
    kcolums = "C"
    Set cellsarea = Intersect(ActiveSheet.UsedRange, Range(kcolums & "1").EntireColumn).sheetcells
    Set cellsarea = cellsarea.Offset(1, 0).Resize(cellsarea.Rows.Count - 1, 1)
    fields = cellsarea.Column - cellsarea.CurrentRegion.sheetcells(1).Column + 1
    For Each sheetcells In cellsarea
        On Error GoTo NoSheet
        nam = Worksheets(sheetcells.Value).Name
        GoTo SheetExists:
NoSheet:
        Set allsheets = Worksheets.Add(Before:=Worksheets(1))
        allsheets.Name = sheetcells.Value
        With sheetcells.CurrentRegion
            .AutoFilter Field:=fields, Criteria1:=sheetcells.Value
            .Specialsheetcells(xlCellTypeVisible).Copy _
                    allsheets.Range("A1")
            allsheets.sheetcells.EntireColumn.AutoFit
            .AutoFilter
        End With
        Resume
SheetExists:
    Next sheetcells
    For Each allsheets In ActiveWorkbook.Worksheets
        If allsheets.Name = allsname Then
            Exit Sub
        Else
            allsheets.Move
            ActiveWorkbook.SaveAs ActiveSheet.Name & ".xls"
            ActiveWorkbook.Close
        End If
    Next allsheets
End Sub

How to save each worksheet as a separate pdf VBA?

Sub Test()
Dim filepath As String
filepath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Sheets
    ws.Copy
    Application.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & ws.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub