Sub Create_New_Sheet()
'Step 1: Declare your Variables
Dim MySheet As Worksheet
Dim MyRange As Range
Dim UList As Collection
Dim UListValue As Variant
Dim i As Long
'Step 2: Set the Sheet that contains the AutoFilter
Set MySheet = ActiveSheet
'Step 3: If the sheet is not auto-filtered, then exit
If MySheet.AutoFilterMode = False Then
Exit Sub
End If
'Step 4: Specify the Column # that holds the data you want filtered
Set MyRange = Range(MySheet.AutoFilter.Range.Columns(1).Address)
'Step 5: Create a new Collection Object
Set UList = New Collection
'Step 6: Fill the Collection Object with Unique Values
On Error Resume Next
For i = 2 To MyRange.Rows.Count
UList.Add MyRange.Cells(i, 1), CStr(MyRange.Cells(i, 1))
Next i
On Error GoTo 0
'Step 7: Start looping in through the collection Values
For Each UListValue In UList
'Step 8: Delete any Sheets that may have bee previously created
On Error Resume Next
Application.DisplayAlerts = False
Sheets(CStr(UListValue)).Delete
Application.DisplayAlerts = True
On Error GoTo 0
'Step 9: Filter the Autofilter to macth the current Value
MyRange.AutoFilter Field:=1, Criteria1:=UListValue
'Step 10: Copy the AutoFiltered Range to new Workbook
MySheet.AutoFilter.Range.Copy
Worksheets.Add.Paste
ActiveSheet.Name = Left(UListValue, 30)
Cells.EntireColumn.AutoFit
'Step 11: Loop back to get the next collection Value
Next UListValue
'Step 12: Go back to main Sheet and removed filters
MySheet.AutoFilter.ShowAllData
MySheet.Select
End Sub