'On a Standard Module
Option Explicit 
 
Sub formshow() 
     'Show Search Form
    UserForm1.Show 
End Sub 
Function FilterAndCopy(rng As Range, Choice As String, Field As String) 
     
    Dim FiltRng As Range 
    Worksheets(Choice).Cells.ClearContents 
    rng.AutoFilter Field:=Field, Criteria1:=Choice 
    On Error Resume Next 
    Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow 
    On Error GoTo 0 
    FiltRng.Copy Worksheets(Choice).Range("A1") 
    Set FiltRng = Nothing 
     
End Function 
Function CreateSheet(Choice As String) 
     
    Dim NewSheet As Worksheet 
     
On Error GoTo Err: 
    Worksheets(Choice).Select 
    Exit Function 
     
Err: 
    Set NewSheet = Worksheets.Add 
    On Error Resume Next 
    NewSheet.Name = Choice 
    On Error GoTo 0 
End Function 
 
 
 'In the userform*******************************************************
Option Explicit 
 
Private Sub CommandButton1_Click() 
    Dim rng As Range 
    Dim ctrl As MSForms.Control 
    Dim Field As String 
     
    Field = ComboBox1.ListIndex + 1 
     
     'Set Error Handling
On Error GoTo ws_exit: 
    Application.EnableEvents = False 
     
     'Set Range
    Set rng = ActiveSheet.UsedRange 
     
    For Each ctrl In UserForm1.Controls 
        If Left(ctrl.Name, 4) = "Text" Then 
            If ctrl.Value <> "" Then 
                CreateSheet ctrl.Value 
                FilterAndCopy rng, ctrl.Value, Field 
                rng.AutoFilter 
            End If 
        End If 
    Next 
    Unload Me 
    Exit Sub 
ws_exit: 
    Set rng = Nothing 
    Application.EnableEvents = True 
    Unload Me 
End Sub 
 
Private Sub CommandButton2_Click() 
     'Cancel Button
    Unload Me 
End Sub 
 
 
Private Sub UserForm_Initialize() 
     
    Dim FillRange       As Range 
    Dim Cel             As Range 
    Dim iLastRow        As Long 
    Dim iLastColumn     As Long 
     
     'Find Last Row
    iLastRow = 1 
     'Find Last Column
    iLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column 
     'Set Range from A1 to Last Row/Column
    Set FillRange = Range("A1", Cells(iLastRow, iLastColumn)) 
     
    For Each Cel In FillRange 
        Me.ComboBox1.AddItem Cel.Text 
    Next 
     
    ComboBox1.ListIndex = 0 
     
    Set Cel = Nothing 
    Set FillRange = Nothing 
     
End Sub