Sub CollectFiles()
    Dim aFiles As Variant
    aFiles = ShowFileDialog()
    If IsEmpty(aFiles) Then Exit Sub
    
    Dim wb1 As Workbook
    Set wb1 = Workbooks.Add(1)
    
    Dim wb2 As Workbook
    Dim vFile As Variant
    For Each vFile In aFiles
        Set wb2 = Workbooks.Open(vFile, False, True)
        CopyWb wb1, wb2
        wb2.Close False
    Next
    wb1.Saved = True
End Sub

Private Sub CopyWb(wb1 As Workbook, wb2 As Workbook)
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    For Each sh2 In wb2.Worksheets
        If sh2.Visible = xlSheetVisible Then
            Select Case sh2.Name
            Case "Инструкция"
            Case Else
                On Error Resume Next
                Set sh1 = wb1.Worksheets(sh2.Name)
                On Error GoTo 0
                If sh1 Is Nothing Then
                    sh2.Copy After:=wb1.Worksheets(wb1.Worksheets.Count)
                Else
                    CopySheets sh1, sh2
                End If
                
                Set sh1 = Nothing
            End Select
        End If
    Next
End Sub

Private Sub CopySheets(sh1 As Worksheet, sh2 As Worksheet)
    Dim arrCopy As Variant
    Dim x2 As Long
    Dim x1 As Long
    Dim y2 As Long
    Dim y1 As Long
    With sh1
        y1 = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    End With
    y2 = sh2.UsedRange.Rows.Count
    For x2 = 1 To sh2.UsedRange.Columns.Count
        If Not IsEmpty(sh2.Cells(2, x2).Value) Then
            x1 = 0
            On Error Resume Next
            x1 = WorksheetFunction.Match(sh2.Cells(2, x2).Value, sh1.Rows(2), 0)
            On Error GoTo 0
            If x1 = 0 Then x1 = sh1.UsedRange.Columns.Count + 1
            With sh2
                If y2 = 4 Then
                    ReDim arrCopy(1 To 1, 1 To 1)
                    arrCopy(1, 1) = .Cells(y2, x2).Value
                Else
                    arrCopy = .Range(.Cells(4, x2), .Cells(y2, x2))
                End If
            End With
            sh1.Cells(y1, x1).Resize(UBound(arrCopy, 1), UBound(arrCopy, 2)) = arrCopy
        End If
    Next
End Sub

Private Function ShowFileDialog() As Variant
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выбрать файлы" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 2 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Path & "\"
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Function 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        Dim arr As Variant
        ReDim arr(1 To .SelectedItems.Count)
        For lf = 1 To .SelectedItems.Count
            arr(lf) = .SelectedItems(lf) 'считываем полный путь к файлу
        Next
    End With
    ShowFileDialog = arr
End Function