How to Split Excel Sheet into Tab Based on Variables in One Column

When working with Excel, you may want to separate the worksheet into different several tabs (or worksheets). There are different methods to separate them.

For example, If you have only a couple of variable in the column, and this is one time work, you can use the "Move and Copy" command to have several worksheets first, then keep one variable in one worksheet. However, if you have many variables or you keep repeating this kind of work, please use the micro with the steps below:

Step 1: Pressing shortcut "Alt+F11" to open the Microsoft Visual Basic for Applications window;

Alternatively, please click the "Developer" tab from the ribbon and click "Visual Basic" to open the window.

Step 2: In the new window, click the "Insert" tab from the ribbon, and click "Module";

Step 3: Copy and paste the following codes in the Module window;

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

    Application.ScreenUpdating = False
    vcol = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Default:="1", Type:=1)
    Set ws = ActiveSheet
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1"
    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

    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))

    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) & ""
            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

    ws.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

Step 4: Click the "Run Sub" button (or press the F5 key) to run the codes;

Step 5: In the pop-up box, enter the column number, e.g., 1, and the worksheet will be split based on the variables in the column;

Step 6: New tabs will appear after.

If you want to further split each tab into separate files, please refer to the post here.

Leave a Reply