Разбивка таблици в новые файлы (массивы)

[Fordros]

Добрый день уважаемые форумчане!
Есть необходимость разбить таблицу на несколько книг, в зависимости от данных.
Таблица содержит в себе колонку со счетами и параметры этих счетов, мне нужно разбить эти счета по отдельным книгам и в название внести параметры (для дальнейшей обработки)... У меня есть код который разбивает массив на файлы но он смотрит только на один параметр, а вот как влепить туда еще несколько я понимаю, но реализацию всего этого - нет =( что-то туго мне массивы даются)

Во вложении пример таблички, который нужно разбивать. Цветом указал что нужно получать в отдельных книгах. Алгоритм себе начертил следующий:

1. 1. Сформировать массив с одинаковыми значениями в столбце 6 (месячный лимит)
2. 2. Разбить массив на несколько подмассивов учитывая параметры (кэш, операций в день, макс. сумма, общ. операций в день)
3. 3. Сохранить каждый подмассив в отдельную книгу с названием книги по маске - к-во общ. операций_макс.сумма_кол-кэш.операций_кэш_мес.лимит (4_1000_4_1000_1000.xlsx)
4. 4. Повторить цикл для следующего массива с одинаковым мес. лимитом

Так же в книге есть код который разбивает табличку по книгам но только по двум критериям...

[Fordros]

Вот что получилось сделать с помощью коллекций... Может как-то оптимизировать?

Sub test()
Application.DisplayAlerts = False
Dim UniqMonth As New Collection
Dim UniqCash As New Collection
Dim UniqCashOperations As New Collection
Dim UniqAllOperations As New Collection
Dim UniqAutorization As New Collection
Dim endRow As Long, i, i1, i2, i3, i4, i5, i6, i7, i8, i9 As Long, xlAPP As Object
Dim Work As Worksheet
Dim objWSHShell As Object
Dim strSpecialFolderPath
Set objWSHShell = CreateObject("WScript.Shell")
SpecialFolderPath = objWSHShell.SpecialFolders("Desktop")
Set objWSHShell = Nothing
Set xlAPP = CreateObject("Excel.Application")
xlAPP.Visible = False
xlAPP.ScreenUpdating = False
Set Work = ActiveSheet
endRow = Work.Cells(2, 1).End(xlDown).Row
arSales = Array()
'Массив валют и счетов
arSales = Work.Range("A2:F" & endRow).Value
For i = 1 To UBound(arSales, 1)
    On Error Resume Next
    UniqMonth.Add arSales(i, 6), CStr(arSales(i, 6))
Next
For i = 1 To UniqMonth.Count
    ArrMonth = ArrAutofilterEx(arSales, "6=" & UniqMonth.Item(i) & "") ' подмассив месячная сумма
    'колекция для кэш
    i1 = 1
    Do While i1 <= UBound(ArrMonth, 1)
        On Error Resume Next
        UniqCash.Add ArrMonth(i1, 5), CStr(ArrMonth(i1, 5))
        i1 = i1 + 1
    Loop
        For i2 = 1 To UniqCash.Count
            ArrCash = ArrAutofilterEx(ArrMonth, "5=" & UniqCash.Item(i2) & "") ' подмассив кэш
            'колекция для кэш операций
            i3 = 1
            Do While i3 <= UBound(ArrCash, 1)
                On Error Resume Next
                UniqCashOperations.Add ArrCash(i3, 4), CStr(ArrCash(i3, 4))
                i3 = i3 + 1
            Loop
                For i4 = 1 To UniqCashOperations.Count
                     ArrCashOperations = ArrAutofilterEx(ArrCash, "4=" & UniqCashOperations.Item(i4) & "") 
                        i5 = 1
                        Do While i5 <= UBound(ArrCashOperations, 1)
                            On Error Resume Next
                            UniqAutorization.Add ArrCashOperations(i5, 3), CStr(ArrCashOperations(i5, 3))
                            i5 = i5 + 1
                        Loop
                            For i6 = 1 To UniqAutorization.Count
                                ArrAutorization = ArrAutofilterEx(ArrCashOperations, "3=" & UniqAutorization.Item(i6) & "") ' подмассив по авторизационной сумме
                                i7 = 1
                                Do While i7 <= UBound(ArrAutorization, 1)
                                    On Error Resume Next
                                    UniqAllOperations.Add ArrAutorization(i7, 2), CStr(ArrAutorization(i7, 2))
                                    i7 = i7 + 1
                                Loop
                                    'Цикл по авторизационной сумме
                                    For i8 = 1 To UniqAllOperations.Count
                                        ArrAllOperations = ArrAutofilterEx(ArrAutorization, "2=" & UniqAllOperations.Item(i8) & "") 
                                        Set xlBook = xlAPP.Workbooks.Add
                                        Set ws = xlBook.Worksheets(1)
                                        ws.Cells.NumberFormat = "@"
                                        ws.Range(ws.Cells(1, 1), ws.Cells(UBound(ArrAllOperations), 1)) = ArrAllOperations
                                        lname = SpecialFolderPath & "\Limit\" & Date & "\" & ArrAllOperations(i8, 2) & "_" & ArrAllOperations(i8, 3) & "_" & ArrAllOperations(i8, 4) & "_" & ArrAllOperations(i8, 5) & "_" & ArrAllOperations(i8, 6) & ".xlsx"
                                        newdir = ThisWorkbook.Path + "\Limit\" & Date & "\"
                                        If Len(Dir(newdir, vbDirectory)) = 0 Then    
                                            SHCreateDirectoryEx Application.hwnd, newdir, ByVal 0&
                                        End If
                                        xlBook.SaveAs lname
                                        xlBook.Close savechanges:=False
                                        xlAPP.ScreenUpdating = True
                                        xlAPP.Quit
                                        Set xlBook = Nothing
                                    Next i8
                                Set UniqAllOperations = Nothing
                            Next i6
                        Set UniqAutorization = Nothing
                Next i4
            Set UniqCashOperations = Nothing
        Next i2
     Set UniqCash = Nothing
Next i
Application.DisplayAlerts = True
End Sub

За функции ArrAutofilterEx спасибо EducatedFool