Public Wkb As Workbook, Sht As Worksheet

Sub Segregate_Into_Worksheets()

'Select the Workbook
Dim FileName As String
FileName = Application.GetOpenFilename

'Open the Workbook
Workbooks.Open (FileName)
Application.Wait (Now + TimeValue("00:00:01"))

'Declare The variable for DataWorkbook
Set Wkb = ActiveWorkbook

'Add Worksheet Names to ListBox
For Each Sht In Wkb.Worksheets
UserForm1.ListBox1.AddItem Sht.Name
Next
UserForm1.Show

End Sub

Private Sub CommandButton1_Click()

HdrRow = Val(Me.TextBox1.Value)
HdrCol = Val(Me.TextBox2.Value)

Set Sht = Wkb.Sheets(Me.ListBox1.Text)
Dim LastRow As Long
LastRow = Sht.Cells(Rows.Count, HdrCol).End(xlUp).Row
If Sht.Cells(HdrRow, HdrCol + 1) <> "" Then
LastCol = Sht.Cells(HdrRow, HdrCol).End(xlToRight).Column
Else:
LastCol = HdrCol
End If
If HdrCol <> 1 Then
'to Find the starting column of the range - It considers upto Blank cell

If Sht.Cells(HdrRow, HdrCol - 1) <> "" Then
Mincol = Sht.Cells(HdrRow, HdrCol).End(xlToLeft).Column
FilterCol = HdrCol - Mincol + 1
End If
If Sht.Cells(HdrRow, HdrCol - 1) = "" Then
Mincol = HdrCol
FilterCol = 1
End If

End If

If HdrCol = 1 Then
Mincol = HdrCol
End If

'Hide the Unselected columns
For i = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Selected(i) = True Then
Else:
Sht.Range(Cells(HdrRow, Mincol), Cells(LastRow, LastCol)).Columns(i + 1).EntireColumn.Hidden = True
End If
Next

Dim R As Long
Dim Rng As Range
Dim NSh As Worksheet
'==================Loop Through all the Rows ===========================
For R = HdrRow + 1 To LastRow
Sht.Select
Set Rng = Sht.Range(Cells(HdrRow + 1, HdrCol), Cells(R, HdrCol))
Criteria = Sht.Cells(R, HdrCol).Value

'Apply the autofilter if it hits the first time
If Application.WorksheetFunction.CountIf(Rng, Criteria) = 1 Then
If Mincol = 1 Then
Sht.Range(Cells(HdrRow, Mincol), Cells(LastRow, LastCol)).AutoFilter field:=HdrCol, Criteria1:=Criteria, Operator:=xlFilterValues
Else:
Sht.Range(Cells(HdrRow, Mincol), Cells(LastRow, LastCol)).AutoFilter field:=FilterCol, Criteria1:=Criteria, Operator:=xlFilterValues
End If
Set NSh = Wkb.Sheets.Add(after:=Wkb.Sheets(Sheets.Count))
ActiveWindow.DisplayGridlines = False
Sht.Select
Sht.Range(Cells(HdrRow, Mincol), Cells(LastRow, LastCol)).SpecialCells(xlCellTypeVisible).Copy NSh.Range("A1")
Sht.Cells(HdrRow, HdrCol).AutoFilter

NSh.UsedRange.ColumnWidth = 9
NSh.Name = Criteria & "_" & Sht.Name
End If
Next
Sht.UsedRange.Columns.Hidden = False
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
Hrow = Val(Me.TextBox1.Value)
HCol = Val(Me.TextBox2.Value)

With Wkb.Sheets(Me.ListBox1.Text)

LastCol = Cells(Hrow, HCol).End(xlToRight).Column
Me.ListBox2.Clear
For C = Wkb.Sheets(Me.ListBox1.Value).Cells(Hrow, HCol).CurrentRegion.Column To LastCol
If .Cells(Hrow, C).Value <> "" Then
Me.ListBox2.AddItem .Cells(Hrow, C).Value
End If
Next

End With
End Sub

Private Sub ListBox1_Change()
With Wkb.Sheets(Me.ListBox1.Text)
.Select
End With

End Sub

Private Sub UserForm_Initialize()
With Me.ListBox1
.Font.Name = "Rockwell"
.ForeColor = RGB(255, 255, 255)
.BackColor = RGB(150, 0, 0)
.Font.Bold = True
.Font.Size = 15
End With

With Me.ListBox2
.Font.Name = "Rockwell"
.ForeColor = RGB(255, 255, 255)
.BackColor = RGB(150, 0, 0)
.Font.Bold = True
.Font.Size = 15
.MultiSelect = fmMultiSelectMulti
End With


With Me.TextBox1
.Font.Name = "Rockwell"
.ForeColor = RGB(255, 255, 255)
.BackColor = RGB(150, 0, 0)
.Font.Bold = True
.Font.Size = 15
End With

With Me.TextBox2
.Font.Name = "Rockwell"
.ForeColor = RGB(255, 255, 255)
.BackColor = RGB(150, 0, 0)
.Font.Bold = True
.Font.Size = 15
End With
End Sub