Нестандартный макрос для обработки таблицы

[Олег Никитин]

Добрый день! Надеюсь на вашу помощь.
Нужно создать макрос для следующих задач:
Есть таблица. В ней, допустим, 5 столбцов. Один из них определяющий (в моем примере это столбец 2, выделенный жирным. Нужно с помощью макроса найти все значения в этом столбце, отличающиеся друг от друга. Вывести каждое(!) значение отдельно вместе со значениями всех остальных столбцов, которые ему соответствуют. По пятому столбцу должна посчитаться сумма всех значений, которые в нем.
При этом желательно, чтобы результаты открывались как новый документ Exel. Возможно ли это? Если нет, то как минимум на новом листе каждый.

Прикрепляю архив. В нем: таблицу 1, исходную. И таблицы 2,3, которые должны получиться.

[RAN.]

В формате BMP дороже.

[Hugo121]

И где сумма?
Сделать можно - есть пара/тройка вариантов в зависимости от общего количества обрабатываемых строк.
Не боитесь, что с такой маскировкой можете разные карты как одну посчитать? Ещё бы фамилии не помешали...

[Олег Никитин]

Сумму я не стал вписывать - пока считаю вручную. Но считать её нужно по 5 столбцу.
Я, естественно, не мог дать скрины полных таблиц с достоверными данными, поэтому тут то, что есть
Общее количество обрабатываемых строк может быть разным, от 5 до 50, поэтому из этого сложно выводы делать.
Подскажите, какие есть варианты?

[Hugo121]

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

Но как сказано выше - из bmp дороже...
Чтоб писать код - нужен файл для проверки. Его создание стОит денег :-)

[Hugo121]

Подарок по случаю праздника
Исходный файл должен быть сохранён - результаты будут помещены рядом в ту же папку.

Option Explicit

Sub otbor()
    Dim i&, a(), kk, x As Range, sh As Worksheet, WBN As Workbook
    Application.ScreenUpdating = False

    Set sh = ActiveSheet
    a = sh.[a1].CurrentRegion.Columns(2).Value

    With CreateObject("Scripting.Dictionary")

        For i = 1 To UBound(a)
            .Item(a(i, 1)) = vbNullString
        Next

        For Each kk In .keys
            Set WBN = Workbooks.Add(xlWBATWorksheet)    'создание новой книги с одним листом
            With sh
                .Rows.Hidden = False
                Set x = .[B:B].Find(kk, , , xlWhole)
                .[B:B].ColumnDifferences(x).EntireRow.Hidden = True
                .Cells.SpecialCells(xlCellTypeVisible).Copy WBN.Sheets(1).[a1]
                i = WBN.Sheets(1).[a1].CurrentRegion.Rows.Count
                WBN.Sheets(1).Cells(i + 1, 5).Formula = "=sum(e1:e" & i & ")"
                WBN.SaveAs ThisWorkbook.Path & "\" & Replace(kk, "*", "_"): WBN.Close 0
                .Rows.Hidden = False
            End With
        Next

    End With

    Application.ScreenUpdating = True
End Sub