Option Explicit
Dim fso As Object
Dim appWord As Object
Dim rOut As Range
    
Sub GetFromWord()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim aFiles As Variant
    aFiles = ShowFileDialog()
    If IsEmpty(aFiles) Then Exit Sub
    
    Set rOut = Workbooks.Add(1).Sheets(1).Cells(1, 1)
    
    Set appWord = CreateObject("Word.Application")
    appWord.Visible = True
    
    Dim vFile As Variant
    For Each vFile In aFiles
        JobWordFile vFile
    Next
    
    appWord.Quit
    Set appWord = Nothing
End Sub

Private Sub JobWordFile(ByVal sFull As String)
    appWord.Documents.Open sFull
    appWord.Selection.WholeStory
    appWord.Selection.Copy
    
    rOut.Parent.Parent.Activate
    rOut.Parent.Activate
    rOut.Select
    With ActiveSheet
        .Paste
        Set rOut = .Cells(.UsedRange.Row + .UsedRange.Rows.Count, 1)
    End With
    
    appWord.ActiveWindow.Close
End Sub

Function ShowFileDialog() As Variant
'    Dim rInitialFileName As Range
'    Set rInitialFileName = ThisWorkbook.Names("шаблон").RefersToRange

    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", "*.doc*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Path & "\" 'rInitialFileName.Value
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If .Show = 0 Then Exit Function 'показывает диалог
        Dim arr As Variant
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To .SelectedItems.Count
            If Left(fso.GetFileName(.SelectedItems(lf)), 2) <> "~$" Then
                If IsEmpty(arr) Then
                    ReDim arr(1 To 1)
'                    rInitialFileName.Value = .SelectedItems(lf)
                Else
                    ReDim Preserve arr(1 To UBound(arr) + 1)
                End If
                arr(UBound(arr)) = .SelectedItems(lf)  'считываем полный путь к файлу
            End If
        Next
        ShowFileDialog = arr
    End With
End Function