Many times, we require to segregate our data into different worksheets. Here we have created a VBA User form 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.
VBA User form for Segregate data into multiple worksheets
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
Visit our YouTube channel to learn step-by-step video tutorials
