Sub Преобразование()
Dim i, myRange As Range, LastRow As Long, LastCol As Long
Dim shtTarget As Worksheet
ThisWorkbook.Worksheets("Лист1").Activate ' активируем лист с фильтром (с которого забираем значения)
With ActiveSheet
.ListObjects("Таблица1").Range.AutoFilter Field:=5, Criteria1:= _
        "ИТ"
LastRow = Cells(1, 1).End(xlDown).Row
LastCol = Cells(1, 1).End(xlToRight).Column
Set myRange = .UsedRange.SpecialCells(xlCellTypeVisible)

Set shtTarget = Sheets.Add(after:=Sheets(Sheets.Count))
shtTarget.Name = "Список по IT"

myRange.Copy
shtTarget.Cells(1, 1).PasteSpecial xlValues
shtTarget.Sort.SortFields.Add _
Key:=Range("I2:I" & LastRow), SortOn:=xlSortOnValues, Order _
        :=xlDescending, DataOption:=xlSortNormal
    With shtTarget.Sort
        .SetRange Range(Cells(1, 1), Cells(LastRow, LastCol))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
shtTarget.ListObjects.Add(xlSrcRange, shtTarget.UsedRange, , xlYes).Name = _
        "РеётингПо_IT"
.ListObjects("Таблица1").Range.AutoFilter Field:=5
End With
End Sub

Sub Список()
    Dim arr, newArr(), sht As Worksheet
    Dim i, k, c, m
    arr = Worksheets("Лист1").Cells(1, 1).CurrentRegion
     c = FindValues(arr)
     m = 1
    ReDim newArr(1 To c, 1 To UBound(arr, 2))
    For i = LBound(arr, 1) To UBound(arr, 1)
    If arr(i, 5) = "ИТ" Then
            For k = LBound(arr, 2) To UBound(arr, 2)
                newArr(m, k) = arr(i, k)
            Next k
    m = m + 1
    End If
    Next i
    newArr = CoolSort(newArr, 9)
    Set sht = Sheets.Add(after:=Sheets(Sheets.Count))
    sht.Name = "СписокПо_IT"
    sht.Cells(1, 1).Resize(1, UBound(arr, 2)) = arr
    sht.Cells(2, 1).Resize(UBound(newArr, 1), UBound(newArr, 2)) = newArr
End Sub

Private Function FindValues(arr)
    Dim i, k
    
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, 5) = "ИТ" Then k = k + 1
    Next i
FindValues = k
End Function

Function sort(arr, N)
Dim i, k, m, temp

arr = ActiveSheet.Cells(1, 1).CurrentRegion

For i = LBound(arr, 1) To UBound(arr, 1) - 1
    For k = i + 1 To UBound(arr, 1)
        If arr(i, N) > arr(k, N) Then
            For m = LBound(arr, 2) To UBound(arr, 2)
                temp = arr(k, m)
                arr(k, m) = arr(i, m)
                arr(i, m) = temp
            Next m
        End If
    Next k
Next i

' код ниже взят с сайта https://excelvba.ru/code/SortArray
Function CoolSort(SourceArr As Variant, ByVal N As Integer) As Variant
    ' сортировка двумерного массива по столбцу N
    Dim Check As Boolean, iCount As Integer, jCount As Integer, nCount As Integer
    ReDim tmpArr(UBound(SourceArr, 2)) As Variant
    Do Until Check
        Check = True
        For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
            If Val(SourceArr(iCount, N)) > Val(SourceArr(iCount + 1, N)) Then
                For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
                    tmpArr(jCount) = SourceArr(iCount, jCount)
                    SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
                    SourceArr(iCount + 1, jCount) = tmpArr(jCount)
                    Check = False
                Next
            End If
        Next
    Loop
    CoolSort = SourceArr
End Function