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

>> Declare different variables.

Application.ScreenUpdating = False

>> This command 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)

>> This command introduces an input box. We will input the column number in the input box.

Set DS = ActiveSheet

>> Fixed 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. And, End(xlUp) choose the last or first row in the upward direction.

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

>> Indicate the first row as the title.

XCL = DS.Columns.Count

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

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

>> Name the range as the “Unique”

For X = 2 To L

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

On Error Resume Next

>> If any error is found resume the operation and go 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

>> If a condition is applied here. The worksheet Match function is used to set the condition.

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

>> We have used the worksheet Transpose function in the line.

DS.Columns(XCL).Clear

>> This is used to clear the contents of the Column marked by the XCL variable.

For X = 2 To UBound(MARY)

>> A For loop is applied here. We set the value of the X from 2 to the upper limit of the array MARY variable.

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

>> Set 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

>> We set another IF condition.

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

>> Copy the data of the whole row.

DS.AutoFilterMode = False

>> This command removes the arrow symbol of the filter drop-down.

DS.Activate

>> Activates the worksheet of the DS variable.

Application.ScreenUpdating = True

>> Enable screen updating by set the value True.