Skip to content Split Data into Multiple Worksheets in Excel VBA
Excel is very helpful when we work with a large amount of data. Periodically we need to split those data into different sheets as per necessity. This article will discuss how to split data into multiple MS Excel worksheets.
Steps to Split Data into Multiple Worksheets
We will split out the data of a sheet into different worksheets using VBA & Macros. In the data set, we’re showing data on PO Numbers and sections.
i will split data into different worksheets based on the column Number.
Step 1:
- We reproduce the data and paste it to another sheet at Cell (A1).
- To perform this method, we must start data from Cell (A1).
Step 2:
- Create a New Macro in Visual Basic Application Module
- Choose the Developer tab.
- Click Visual Basic
- Insert a Module default name is “Module1”
- copy code and paste it
Sub Split_Data_PO()
Dim L As Long
Dim WS As Worksheet
Dim I, X As Integer
Dim LO As Long
Dim MARY As Variant
Dim title As String
Dim titlerow As Integer
Application.ScreenUpdating = False
I = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Type:=1)
Set WS = ActiveSheet
L = WS.Cells(WS.Rows.Count, I).End(xlUp).Row
title = "A1"
titlerow = WS.Range(title).Cells(1).Row
LO = WS.Columns.Count
WS.Cells(3, LO) = "Unique"
For X = 2 To L
On Error Resume Next
If WS.Cells(X, I) <> "" And Application.WorksheetFunction.Match(WS.Cells(X, I), WS.Columns(LO), 0) = 0 Then
WS.Cells(WS.Rows.Count, LO).End(xlUp).Offset(1) = WS.Cells(X, I)
End If
Next
MARY = Application.WorksheetFunction.Transpose(WS.Columns(LO).SpecialCells(xlCellTypeConstants))
WS.Columns(LO).Clear
For X = 2 To UBound(MARY)
WS.Range(title).AutoFilter field:=I, Criteria1:=MARY(X) & ""
If Not Evaluate("=ISREF('" & MARY(X) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = MARY(X) & ""
Else
Sheets(MARY(X) & "").Move after:=Worksheets(Worksheets.Count)
End If
WS.Range("A" & titlerow & ":A" & L).EntireRow.Copy Sheets(MARY(X) & "").Range("A4")
Next
WS.AutoFilterMode = False
WS.Activate
Application.ScreenUpdating = True
End Sub
Step 3:
Save the File in XLSM Format and Run the Macro
- Then press (F5) to execute the code.
- A dialogue box will appear to input a digit.
- Enter 5 here, as we want to split data based on Column.
After inputting the number press OK. We will get data into different sheets now.
Code Explanation:
Dim L As Long
Dim WS As Worksheet
Dim I, X As Integer
Dim LO As Long
Dim MARY As Variant
Dim title As String
Dim titlerow As Integer
Declare the different variables.
Application.ScreenUpdating = False This command defines whether the screen will update or not here; false stop Screen updating. Screen update is turned off to optimize the current macro code.
I = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Type:=1) This command presents an input box. We will input the column digit in the input box.
Set WS = ActiveSheet Set active sheet as the value of the (WS) variable.
L = DS.Cells(DS.Rows.Count, VCL).End(xlUp).Row WS.Cells(WS.Rows.Count, I) define that our reference is a cell of column I located at the last row of the WS sheet. And, End(xlUp), choose the previous or first row in the upward direction.
titlerow = WS.Range(title).Cells(1).Row Indicate the first row in the title.
LO = WS.Columns.Count Count the number of columns into the LO variable.
WS.Cells(3, LO) = "Unique" The name the range as “Unique”
For X = 2 To L Use loop and set the value of X from 2 to L
On Error Resume Next If any error is found skip the operation and go to the Next section.
If WS.Cells(X, I) <> "" And Application.WorksheetFunction.Match(WS.Cells(X, I), WS.Columns(LO), 0) = 0 Then
WS.Cells(WS.Rows.Count, LO).End(xlUp).Offset(1) = WS.Cells(X, I)
End If
Next IF the condition is applied here, the worksheet Match function is utilized to set the state.
MARY = Application.WorksheetFunction.Transpose(WS.Columns(LO).SpecialCells(xlCellTypeConstants)) used the worksheet Transpose function in the line.
WS.Columns(LO).Clear used to clear the contents of the Column marked by the LO variable.
For X = 2 To UBound(MARY) (A) the loop is applied here; we set the value of the X from 2 to the upper limitation of the array MARY variable.
WS.Range(title).AutoFilter field:=I, Criteria1:=MARY(X) & ""
If Not Evaluate("=ISREF('" & MARY(X) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = MARY(X) & ""
Else
Sheets(MARY(X) & "").Move after:=Worksheets(Worksheets.Count)
End If
WS.Range("A" & titlerow & ":A" & L).EntireRow.Copy Sheets(MARY(X) & "").Range("A4")
Next
Copy the data of the whole row and next
WS.AutoFilterMode = False The command removes the arrow sign of the filter drop-down.
WS.Activate
Application.ScreenUpdating = True
