Мульти вопрос. Консолидация данных

[sanych_09]

Доброго времени суток!
сделал сводную табличку лист Summary. в шапке заранее прописал критерии, имена столбцов с других таблиц которые бы я хотел видеть в одном листе. так как расположение нужных мне столбцов в листах (их у меня 17) разное, пользовался формулой ВПР(vlookup), ДВССЫЛ(indirect) и ПОИСКПОЗ(match)
вроде все получилось, но почему-то есть ошибки, выделил их красным. если без использования ДВССЫЛ и вручную указать для формулы ВПР что искать - то выводит нужное значение..

в связи с этим

помогите решить несколько вопросов:

1. автоматическое копирование информации SITE ID со всех листов и вставкой друг за другом в вертикальном порядке в Лист Summary и добавлением имени листа, с которого SITE ID было скопировано.

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

2. почему по некоторым SITE ID выводиться #Н/Д?
3. как не отображать 00.01.1900? один из способов видел изменить в параметрах: не отображать нули или добавить если()... может еще как-то можно?

4. возможно ли обойтись без формул и сделать это все с помощью макроса? Который бы делал сводный отчетик если в листе Summary в первой строке (шапке) прописать заранее имена нужных столбцов из которых нужно получить данные (количество столбиков в шапке может меняться)

файлик прилагаю

[sanych_09]

На другом форуме добрый человек помог с макросом.
файл в приложении. Код работает, но при условии, что во всех листах Vendor находится во втором столбце. а в разных листах он может быть в разных столбцах, точно также как и другие значения в шапке. не могу разобраться где нужно сделать изменения чтобы начиная с 3-го столбца макрос искал нужные столбы в листах и копировал в Summary

Sub just_dic()
Dim sh As Worksheet, lc&, rng As Range, d As Object, k, a, arr, art$, coll, col$, c&, el&, i&, j&, head

With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With

'создали словарь
Set d = CreateObject("Scripting.Dictionary")
d.comparemode = 1    'текстовое сравнение

For Each sh In ThisWorkbook.Sheets  'цикл по листам
With sh
If .Name <> "Лист1" Then    'листы, который не надо обрабатывать !!!

' лист "Summary"
If .Name = "Summary" Then
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
    ' собираем шапку (должна быть заполнена!!)
    Set rng = sh.Range(.[d1], .Cells(1, lc))
    ReDim arr(1 To rng.Cells.Count)
    For i = 1 To rng.Cells.Count
    arr(i) = Trim(rng.Cells(1, i).Value)
    Next i
    'массив шапки в строковую переменную записываем
    art$ = Join(arr, "|")
    art$ = "|" & art$ & "|"
    
Else
'любой др лист
    On Error Resume Next
    a = sh.UsedRange.Value    'массив листа
    col$ = ""
    'отбор нужных столбцов - цикл по столбцам массива листа
        For j = 3 To UBound(a, 2)
            If InStr(art$, "|" & Trim(a(1, j)) & "|") <> 0 Then     'сверка с шапкой
                col$ = col$ & j & "|"
            End If
        Next j
        col$ = Left(col$, Len(col$) - 1)
        coll = Split(col$, "|")
        
     'цикл по строкам массива листа
        For i = 2 To UBound(a)
            k = Trim(a(i, 1)) & "|" & .Name & "|" & Trim(a(i, 2)) 'ключ из столбцов SITE ID, Project, Vendor
                
            If Not d.exists(k) Then d.Add k     ' если нет в словаре, добавляем ключ
                    'собираем значения под ключ из нужных столбцов
                    For el = 0 To UBound(coll)
                      c = coll(el)
                            d.Item(k) = d.Item(k) & "|" & (a(i, c))
                    Next el
                    d.Item(k) = Right(d.Item(k), Len(d.Item(k)) - 1)
         Next i
    On Error GoTo 0
    
End If
End If
End With
Next sh

With ThisWorkbook.Sheets("Summary")
'запоминаем шапку
head = .[a1].Resize(1, .Cells(1, .Columns.Count).End(xlToLeft).Column).Value
'очищаем лист
.UsedRange.Cells.ClearContents
'выгрузка
.[a2].Resize(d.Count, 1) = Application.Transpose(Array(d.Keys))
.[a2].Resize(d.Count, 1).TextToColumns Destination:=Range("a2"), DataType:=xlDelimited, _
        Other:=True, OtherChar:="|"
.[d2].Resize(d.Count, 1) = Application.Transpose(Array(d.items))
.[d2].Resize(d.Count, 1).TextToColumns Destination:=Range("d2"), DataType:=xlDelimited, _
        Other:=True, OtherChar:="|"
.[a1].Resize(1, UBound(head, 2)).Value = head
'автоподбор ширины столбцов
.[a1].CurrentRegion.Columns.AutoFit
End With
With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With
    
End Sub

спасибо!