Свод из нескольких таблиц в одну

[maso89]

Здравствуйте,форумчане!
Столкнулся с такой проблемой: Есть несколько листов. Каждый лист это вид работ. В таблице представлены данные в виде адресов домов, площади, итд. Все листы имеют одинаковые столбцы.
Необходимо свести всё в одну сводную таблицу.
Каждому из листов соответствует название столбца сводной таблицы.
Адресов в каждой таблице может быть около тысячи. При этом они могут повторяться, а могут и нет. Если значение уникально добавляется новая строчка с адресом, если уже ранее строка встречалась в сводной таблице, то алгоритм ищет в каком листе встретился адрес и вписывает в одноименный столбец. Как-то так. Тяжело объяснить, может пример поможет. Заранее спасибо. Данные просто туча, вручную сводить нереал.

[IgorGO]

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

[Hugo121]

Я думаю быстро будет макросом циклом по листам/данным собрать словарь с коллекциями - ключ собираем из "координат" дома, а в item коллекцию название листа & "|" & Период капитального ремонта.
Параллельно собираем коллекцию названий листов. Или лучше словарь, чтоб сразу иметь индекс названия на будущее.
Далее создать массив по размеру словаря и этой коллекции, заполнить шапку названиями листов (вернее два параллельных массива - один для домов, второй с этой шапкой для ремонтов), циклом по словарю (и его коллекциям) и шапке заполняем массивы собранными данными.
Выгрузка результата.

Писать сравнительно много, тщательно, некогда... Если не будет других вариантов - за небесплатно в порядке живой очереди можно подумать...
Ну или реализуйте сами - вроде расписал подробно.

[maksim_serg]

если это нужно один раз в жизни, то проще руками. создать на каждом листе доп столбец, что вроде "=сцепить(А1;Б1;В1...)". все это скопировать на сводный лист, удалить дубликаты стандартной функцией, а дальше через ВПР. Часто сам так делаю

[Step_UA]

не так уж и много писать

Sub Собрать()
  Dim Dic As Object, i&, j&, Row&, cRow&, cCol&, tmp, s$
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.comparemode = 1
    cCol = Sheets.Count + 10
    ReDim mas(1 To 999, 1 To cCol)
    For i = 12 To cCol
        With Sheets(i - 11)
            tmp = .Range(.Cells.Find("Муниципальный район/городской округ").Offset(1), .Cells(Rows.Count, 12).End(xlUp)).Value
        End With
        For Row = 1 To UBound(tmp)
            s = tmp(Row, 1) & "|" & tmp(Row, 2) & "|" & tmp(Row, 3) & "|" & tmp(Row, 4) & "|" & _
                    tmp(Row, 5) & "|" & tmp(Row, 6) & "|" & tmp(Row, 7) & "|" & tmp(Row, 8)
            If Dic.exists(s) = False Then
                cRow = cRow + 1
                If cRow Mod 1000 = 0 Then ReDim Preserve mas(1 To cRow + 999, 1 To cCol)
                Dic(s) = cRow
                mas(cRow, 1) = cRow
                For j = 2 To 11: mas(cRow, j) = tmp(Row, j - 1): Next
            End If
            mas(Dic(s), i) = tmp(Row, 11)
        Next
    Next
    With Sheets(Sheets.Count).Cells(7, 1).Resize(cRow, cCol)
        .Value = mas
        .Borders.LineStyle = 1
    End With
End Sub

[Hugo121]

Ну а разве мало написано?
Я предлагал чуть иначе, чтоб не привязываться к названиям/расположению листов и шапки - брать все встретившиеся названия и создать из них шапку, соотв. и расположение данных будет этому соответствовать.

[Step_UA]

Hugo121, скорее всего ТС необходимо это выполнить разово, поэтому не заморачивался ... да и подписи в таблице не совпадают с наименованиями листов