Sub iSelectColumnForFilter()
Dim i As Long
Dim n As Integer
Dim Criterij As String
Dim iName As String
Dim Sht As Worksheet
Dim Sht_table As String
Dim iLastCol As Integer
Dim iSelectCol As Integer
Dim iLastRow As Long
Application.ScreenUpdating = False
  Application.DisplayAlerts = False          'îòêëþ÷åíèå ïðåäóïðåæäàþùèõ ñîîáùåíèé
   Sht_table = ActiveSheet.Name
    For Each Sht In ThisWorkbook.Worksheets  'óäàëÿåì âñå ëèñòû, êðîìå Sht_table
      If Sht.Name <> Sht_table Then Sht.Delete
    Next
  Application.DisplayAlerts = True
   iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column  'ïîñëåäíèé ñòîëáåö
  iSelectCol = Application.InputBox("Âûáåðèòå íîìåð ñòîëáöà ôèëüòðàöèè", Type:=1)
  If iSelectCol > iLastCol Then MsgBox "Âûáðàííûé ñòîëáåö âûõîäèò çà äèàïàçîí ñòîëáöîâ": Exit Sub
  Set Sht = ThisWorkbook.Worksheets(Sht_table)
   iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
        Columns(iLastCol + 2).ClearContents
    Range(Cells(1, iSelectCol), Cells(iLastRow, iSelectCol)).AdvancedFilter Action:=xlFilterCopy _
                                  , CopyToRange:=Cells(1, iLastCol + 2), Unique:=True
        n = Cells(Rows.Count, iLastCol + 2).End(xlUp).Row
    For i = 2 To n          'öèêë ïî óíèêàëüíûì çíà÷åíèÿì âûáðàííîãî ñòîëáöà
        Criterij = Sht.Cells(i, iLastCol + 2)
        iName = Criterij    'èìÿ íîâîãî ëèñòà
       Sht.Range(Sht.Cells(1, 1), Sht.Cells(iLastRow, iLastCol)).AutoFilter iSelectCol, Criterij
        Sht.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
        With Worksheets.Add(After:=Worksheets(Worksheets.Count))  'äîáàâëÿåò íîâûé ëèñò â êîíåö
          .Range(Cells(1, 1), Cells(1, iLastCol)).PasteSpecial xlPasteColumnWidths
          .Range(Cells(1, 1), Cells(1, iLastCol)).PasteSpecial xlPasteFormats
          .Range(Cells(1, 1), Cells(1, iLastCol)).PasteSpecial xlPasteValues
          Sht.AutoFilter.Range.AutoFilter
          .Name = iName
          .Range("A1").Select
        End With
    Next
Application.ScreenUpdating = True
   Sht.Activate
   Columns(iLastCol + 2).ClearContents
End Sub