VBA User form for Segregate data into multiple worksheets

Many times, we require to segregate our data into different worksheets. Here we have created a macro which can segregate your data into worksheets. One user from will be displayed wherein you can select the field name by which you want to segregate your data.

Table of Contents

Below is the data which we will segregate into multiple worksheets-

We have added an icon on home tab to run this macro-

Below given user form will be displayed after clicking on this icon

Select any field and click on run.
Data will be segregated into different worksheet-

Below is code of this user form-

Option Explicit

Private Sub CommandButton1_Click()

Application.DisplayAlerts = False

Dim nwb As Workbook
Dim nsh As Worksheet
Dim dsh As Worksheet
Dim support As Worksheet

Set dsh = ActiveSheet

Dim col_number As Integer
Dim i As Integer

col_number = Application.WorksheetFunction.Match(Me.ComboBox1.Value, dsh.Range("1:1"), 0)

Set nwb = Workbooks.Add
Set support = nwb.Sheets(1)

dsh.AutoFilterMode = False
dsh.Cells(1, col_number).EntireColumn.Copy
support.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
support.UsedRange.RemoveDuplicates 1, xlYes

For i = 2 To Application.CountA(support.Range("A:A"))
Set nsh = nwb.Sheets.Add(after:=Sheets(Sheets.Count))
dsh.UsedRange.AutoFilter col_number, VBA.IIf(support.Range("A" & i).NumberFormat = "General", support.Range("A" & i).Value, VBA.Format(support.Range("A" & i).Value, support.Range("A" & i).NumberFormat))
dsh.UsedRange.Copy nsh.Range("A1")
On Error Resume Next
nsh.Name = VBA.IIf(support.Range("A" & i).NumberFormat = "General", support.Range("A" & i).Value, VBA.Format(support.Range("A" & i).Value, support.Range("A" & i).NumberFormat))
On Error GoTo 0

nsh.UsedRange.EntireColumn.ColumnWidth = 25
dsh.AutoFilterMode = False
ActiveWindow.DisplayGridlines = False
Next i

support.Delete

MsgBox "Process Completed"

End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub


Private Sub UserForm_Initialize()

If Application.WorksheetFunction.CountA(ActiveSheet.Range("1:1")) > 0 Then
Dim i As Integer
For i = 1 To Application.WorksheetFunction.CountA(ActiveSheet.Range("1:1"))
If ActiveSheet.Cells(1, i).Value <> "" Then
Me.ComboBox1.AddItem ActiveSheet.Cells(1, i).Value
End If
Next i
End If

End Sub