Sub main()
    Dim ra As Range: Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 9)
    Dim raa As Range: Set raa = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 10)
    ra.Borders.LineStyle = xlContinuous    ' границы
    ra.Sort ra.Cells(9), xlAscending, , , , , , xlNo    ' сортировка
    arr = ra.Value ' считываем данные
    raa.Borders.LineStyle = xlContinuous    ' границы
    raa.Sort raa.Cells(10), xlAscending, , , , , , xlNo    ' сортировка
    arrr = raa.Value ' считываем данные
    Application.ScreenUpdating = False
    For Each v In UniqueValuesFromArray(arr, 9)    ' перебираем все уникальные UIN
    
    For Each vv In UniqueValuesFromArray(arrr, 10)    ' перебираем все уникальные UIN
     
       
        arr2 = ArrAutofilterEx(arr, "9=" & v)    ' фильтруем массив данных
        arrrr = ArrAutofilterEx(arrr, "10=" & vv)    ' фильтруем массив данных
        Range("1:1").Copy Range("A" & Rows.Count).End(xlUp).Offset(2)    ' копируем строку заголовка
        With Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(arr2), 9)
        With Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(arrrr), 10)
            .Value = arr2    ' вставляем отфильтрованные данные
            .Value = arrrr    ' вставляем отфильтрованные данные
            .Borders.LineStyle = xlContinuous    ' границы
        End With
  End With
        

        
    Next
     Next
End Sub

Function UniqueValuesFromArray(ByVal arr, ByVal col As Long) As Variant
    ' перебирает все значения в столбце Col двумерного массива arr
    ' в поисках уникальных значений. Возвращает двумерный вертикальный массив
    ' размерностью N * 1, содержащий уникальные значения из столбца col
    If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical: Exit Function
    If col > UBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
    If col < LBound(arr, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function

    On Error Resume Next: Dim coll As New Collection, txt$
    For i = LBound(arr) To UBound(arr)
        txt$ = Trim(arr(i, col)): coll.Add txt$, txt$
    Next i
    ReDim newarr(1 To coll.Count, 1 To 1)
    For i = 1 To coll.Count: newarr(i, 1) = coll(i): Next i
    UniqueValuesFromArray = newarr
End Function
Function UniqueValuesFromArray2(ByVal arr2, ByVal col As Long) As Variant
    ' перебирает все значения в столбце Col двумерного массива arr
    ' в поисках уникальных значений. Возвращает двумерный вертикальный массив
    ' размерностью N * 1, содержащий уникальные значения из столбца col
    If Not IsArray(arr2) Then MsgBox "Это не массив!", vbCritical: Exit Function
    If col > UBound(arr2, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
    If col < LBound(arr2, 2) Then MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function

    On Error Resume Next: Dim coll As New Collection, txt$
    For i = LBound(arr) To UBound(arr)
        txt$ = Trim(arr2(i, col)): coll.Add txt$, txt$
    Next i
    ReDim newarr(1 To coll.Count, 1 To 1)
    For i = 1 To coll.Count: newarr(i, 1) = coll(i): Next i
    UniqueValuesFromArray2 = newarr2
End Function

Function ArrAutofilterEx(ByRef arr, ParamArray args() As Variant) As Variant
    ' получает по ссылке массив ARR для фильтрации
    ' и список критериев фильтрации в формате "3=некий текст" (номер столбца, "=", искомое значение)
    ' возвращает двумерный массив с подходящими строками
    Dim Index As Long, OK As Boolean, ComparedColumn As Long, res As String

    If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical, _
       "Ошибка в функции ArrAutofilter": Exit Function

    For Index = LBound(args) To UBound(args)    ' перебираем все параметры фильтрации
        If Not IsMissing(args(Index)) Then
            If GetAutofilterArgument(args(Index), ComparedColumn, res) Then
                If (ComparedColumn > UBound(arr, 2)) Or (ComparedColumn < LBound(arr, 2)) Then _
                   ArrAutofilter = ArrAutofilter & "В массиве нет столбца с номером " & _
                   ComparedColumn & vbNewLine
            Else
                ArrAutofilter = ArrAutofilter & "Неверно сформирована строка фильтрации: " & _
                                args(Index) & vbNewLine
            End If
        Else
            ArrAutofilter = ArrAutofilter & (Index + 1) & "-й аргумент фильтрации отсутствует" & _
                            vbNewLine
        End If
    Next Index
    If Len(ArrAutofilter) Then
        MsgBox ArrAutofilter, vbCritical, "Ошибка в функции ArrAutofilter"
        ArrAutofilterEx = "": Exit Function
    End If

    Dim coll As New Collection
    For i = LBound(arr, 1) To UBound(arr, 1)    ' перебираем все строки массива
        OK = True
        For Index = LBound(args) To UBound(args)    ' перебираем все параметры фильтрации
            ' получаем параметры фильтрации
            X = GetAutofilterArgument(args(Index), ComparedColumn, res)
            If Not (arr(i, ComparedColumn) Like res) Then OK = False: Exit For
        Next Index
        If OK Then coll.Add i
    Next i

    ' формируем новый массив
    ReDim newarr(1 To coll.Count, LBound(arr, 2) To UBound(arr, 2))
    For i = 1 To coll.Count
        ro = coll(i)
        For j = LBound(arr, 2) To UBound(arr, 2): newarr(i, j) = arr(ro, j): Next j
    Next i

    ArrAutofilterEx = newarr
End Function

Function GetAutofilterArgument(ByVal arg, ByRef col As Long, ByRef searchStr As String) As Boolean
    col = 0: searchStr = ""
    If UBound(Split(arg, "=")) < 1 Then Exit Function    ' нет знака =
    sCol = Split(arg, "=")(0): If Len(sCol) = 0 Or Not sCol Like String(Len(sCol), "#") Then _
                                  Exit Function  ' номер столбца не соответствует
    searchStr = Mid$(arg, Len(sCol) + 2): col = Val(sCol)
    If col > 0 Then GetAutofilterArgument = True
End Function