Split Data into Multiple Worksheets in Excel (with Quick Steps)

Sub Split_Data()
Dim L As Long
    Dim DS As Worksheet
    Dim VCL, X As Integer
    Dim XCL As Long
    Dim MARY As Variant
    Dim title As String
    Dim titlerow As Integer
    Application.ScreenUpdating = False
    VCL = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Type:=1)
    Set DS = ActiveSheet
    L = DS.Cells(DS.Rows.Count, VCL).End(xlUp).Row
    title = "A1"
    titlerow = DS.Range(title).Cells(1).Row
    XCL = DS.Columns.Count
    DS.Cells(3, XCL) = "Unique"
    For X = 2 To L
        On Error Resume Next
        If DS.Cells(X, VCL) <> "" And Application.WorksheetFunction.Match(DS.Cells(X, VCL), DS.Columns(XCL), 0) = 0 Then
            DS.Cells(DS.Rows.Count, XCL).End(xlUp).Offset(1) = DS.Cells(X, VCL)
        End If
    Next
    MARY = Application.WorksheetFunction.Transpose(DS.Columns(XCL).SpecialCells(xlCellTypeConstants))
    DS.Columns(XCL).Clear
    For X = 2 To UBound(MARY)
        DS.Range(title).AutoFilter field:=VCL, 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
        DS.Range("A" & titlerow & ":A" & L).EntireRow.Copy Sheets(MARY(X) & "").Range("A4")
    Next
    DS.AutoFilterMode = False
    DS.Activate
    Application.ScreenUpdating = True
End Sub 
			

Code Explanation:

Dim L As Long
Dim DS As Worksheet
Dim VCL, X As Integer
Dim XCL As Long
Dim MARY As Variant
Dim title As String
Dim titlerow As Integer

>> Declares different variables.

Application.ScreenUpdating = False

>> Defines whether the screen will update or not. Here, False stops updating. Screen update is turned off to speed up the macro.

VCL = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Type:=1)

>>Introduces an input box, into which we will input the column number.

Set DS = ActiveSheet

>> Fixes the active sheet as the value of the DS variable.

L = DS.Cells(DS.Rows.Count, VCL).End(xlUp).Row

>> DS.Cells(DS.Rows.Count, VCL) defines that our reference is a cell of column VCL located at the last row of the DS sheet. End(xlUp) chooses the last or first row in the upward direction.

titlerow = DS.Range(title).Cells(1).Row

>> Indicates the first row as the title.

XCL = DS.Columns.Count

>> Counts the number of columns into the XCL variable.

DS.Cells(3, XCL) = "Unique"

>> Names the range as “Unique”

For X = 2 To L

>> Uses For loop to set the value of X from 2 to L

On Error Resume Next

>> If any error is found, resumes the operation and goes to the Next section.

If DS.Cells(X, VCL) <> "" And Application.WorksheetFunction.Match(DS.Cells(X, VCL), DS.Columns(XCL), 0) = 0 Then
DS.Cells(DS.Rows.Count, XCL).End(xlUp).Offset(1) = DS.Cells(X, VCL)
End If

>> Applies a condition using the worksheet Match function.

MARY = Application.WorksheetFunction.Transpose(DS.Columns(XCL).SpecialCells(xlCellTypeConstants))

>> Uses the worksheet Transpose function on the line.

DS.Columns(XCL).Clear

>> Clears the contents of the Column marked by the XCL variable.

For X = 2 To UBound(MARY)

>> Applies a For loop, with the value of the X set from 2 to the upper limit of the array MARY variable.

DS.Range(title).AutoFilter field:=VCL, Criteria1:=MARY(X) & ""

>> Sets the VCL variable as the range of AutoFilter.

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

>> Sets another IF condition.

DS.Range("A" & titlerow & ":A" & L).EntireRow.Copy Sheets(MARY(X) & "").Range("A4")

>> Copies the data of the whole row.

DS.AutoFilterMode = False

>> Removes the arrow symbol of the filter drop-down.

DS.Activate

>> Activates the worksheet of the DS variable.

Application.ScreenUpdating = True

>> Enables screen updating by setting the value True.