VBA Макросы: Вставка таблиц из одного документа word в другой

[siv14]

Добрый день!
Есть еще одна задача. В программе формируется Документ1.docx в котором находится одна таблица. Документ не сохраняем, т.к. он в дальнейшем будет не нужен. Нужно из этого документа скопировать таблицу, вставить в другой документ (из которого запускается макрос) в определенное место, затем удалить Документ1.
Такое реально сделать?

[Администратор]

Как тестировать.
В самих файлах макроса нет.
Откройте файл "результат", из VBA запустите макрос, появится диалог для выбора файлов, выберите файл "таблица".
Макрос скопирует таблицу из одного файла в другой.

В файле "результат" есть текст-метка. Макрос её находит и в неё вставляет таблицу. Жёлтым я выделил, чтобы метка бросалась в глаза.
Закраску можете не использовать. Символ "~" вводится с клавиатуры. Это обычный символ. Он редкий, поэтому его можно использовать для создания текста-метки.

Макрос

Sub макрос()
   
    Dim docSrc As Document, docRes As Document, rngTable As Range
    Dim strFN As String

   
    '1. Отключение монитора. Может это уменьшит мерцание и может ускорит макрос.
    Application.ScreenUpdating = False

    '2. Юзер выбирает файл, в котором таблица.
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Документы Word", "*.docx"
        If .Show = 0 Then
            Exit Sub
        End If
        strFN = .SelectedItems(1)
    End With
   
    '3. Присваивание имени "docRes" активного файлу (в который надо вставить таблицу).
        ' После открытия другого файла, он станет неактивным.
    Set docRes = ActiveDocument
   
    '4. Открытие файла, в котором таблица. При этом присваиваем файлу имя "docSrc".
    Set docSrc = Documents.Open(FileName:=strFN)
   
    '5. Копирование таблицы из одного файла в другой.
    With docRes.Range.find
        ' Текст-метка, куда надо вставить таблицу.
        .Text = "~таблица~"
        ' Поиск текста-метки.
        .Execute
        ' Присваиваем имя "rngTable" фрагменту, в котором находится текст-метка.
            ' Parent - это найденный текст.
        Set rngTable = .Parent
    End With
   
    '6. Убираем цветовую заливку.
    rngTable.HighlightColorIndex = wdNoHighlight
   
    '7. Вставка таблицы. Копируется первая таблица из файла-источника.
    docSrc.Tables(1).Range.Copy
    rngTable.Paste
   
    '8. Очистка буфера обмена. Если таблица большая, то при закрытии ворда
        ' будет сообщение, что в буфере много данных.
        ' Просто копируем первый символ.
    docSrc.Range.Characters(1).Copy
   
    '9. Закрытие файла-источника.
    docSrc.Close SaveChanges:=False
   
    '10. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub

[свернуть]

[siv14]

Протестировал макрос, все отлично.