How to export and save each worksheet as new workbook in Excel

excel - VBA - Saving all worksheets as separate files

if you want to save your multiple excel worksheet as a separate workbook at specific folder then you are right place..

Open Visual basic editor by pressing alt+F11
On project window at left side => right click on project => insert=>Module.
now paste below code. read comments and set your parameter.

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


=========================
now its time to run your code by pressing F5.
Done!

Excel VBA- split data into multiple worksheets based on column

 Here VBA Code to split data into multiple worksheets based on selected column

If you have an excel sheet and want to split the data into individual multiple sheet based on column valued then the below code is best for you.


Open Visual basic editor by pressing alt+F11
On project window at left side => right click on project => insert=>Module.
now paste below code. read comments and set your parameter.

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 7  ''number of column on which basis you want to create saprate sheet
Set ws = Sheets("finalsheet")  ''name of your master sheet which need to compile
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:V1"  ''range of column which need to transfer into each individual sheet
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub



=========================
now its time to run your code by pressing F5.
Done!