Sub Vlookup2()

Dim WB As Workbook, FileName As String, CompanyName As String, GetFile As FileDialog, y As Long
Dim a, t$, tt$, ttt$, maindic As Object, bookdic As Object, i&, ii&, k

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

Set WB = ThisWorkbook

'блок окна выбора файлов
Set GetFile = Application.FileDialog(msoFileDialogFilePicker)
With GetFile
    .AllowMultiSelect = True
    .Title = "Выберите файлы"
    .Filters.Clear
    .Filters.Add "Excel files", "*.xls*;*.xla*", 1
    .FilterIndex = 1
    .InitialView = msoFileDialogViewDetails
    
    If GetFile.Show = 0 Then Exit Sub
    
    Set maindic = CreateObject("Scripting.Dictionary"): maindic.CompareMode = 1
    Set bookdic = CreateObject("Scripting.Dictionary"): bookdic.CompareMode = 1
    
    t = Trim(Range("B7").Value)

    For y = 1 To .SelectedItems.Count
        FileName = .SelectedItems(y)
        
       With GetObject(FileName)
          CompanyName = Left(.Name, 1)
          bookdic.Item(CompanyName) = 0&
          
          a = .Sheets(1).Range("A1").CurrentRegion.Value
          For i = 2 To UBound(a)
          If a(i, 1) = t Then
          tt = CompanyName & "|" & t
            For ii = 2 To UBound(a, 2)
                ttt = tt & "|" & a(1, ii)
                'Debug.Print ttt & "-" & a(i, ii)
                maindic.Item(ttt) = a(i, ii)
            Next
          End If
          Next
          .Close 0
        End With
          
    Next
End With

'блок выгрузки данных
i = 1
For Each k In bookdic.keys
i = i + 1
Cells(i, 9) = i - 1
Cells(i, 10) = k

For ii = 11 To 14
Cells(i, ii) = maindic.Item(k & "|" & t & "|" & Cells(1, ii))
Next
Next
   
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
End With

MsgBox "Done"
End Sub