Home>Blogs>VBA>VBA User form for Segregate data into multiple worksheets
Segregate data into Worksheets
VBA

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

Data
Data

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

Icon
Icon

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

VBA User form
VBA User form
  • Select any field and click on run.
  • Data will be segregated into different worksheet-
Segregated data
Segregated data

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

Youtube.com/@PKAnExcelExpert

Watch the step by step video tutorial:

PK
Meet PK, the founder of PK-AnExcelExpert.com! With over 15 years of experience in Data Visualization, Excel Automation, and dashboard creation. PK is a Microsoft Certified Professional who has a passion for all things in Excel. PK loves to explore new and innovative ways to use Excel and is always eager to share his knowledge with others. With an eye for detail and a commitment to excellence, PK has become a go-to expert in the world of Excel. Whether you're looking to create stunning visualizations or streamline your workflow with automation, PK has the skills and expertise to help you succeed. Join the many satisfied clients who have benefited from PK's services and see how he can take your Excel skills to the next level!
https://www.pk-anexcelexpert.com