Как вставить значения в ячейки Excel с соответсвующими именами и закладки в Word

[Snekich]

Добрый день.
Мне необходимо сделать следующее:
1) Скопировать файлы из папки "Шаблоны" в папку "Результат" и переименовать файлы в папке "Результат" в соответствии с таблицей - СДЕЛАЛ
2) В папке "Результат" (с подпапками) во всех файлах Excel вставить значения в ячейки (с присвоенными именами) из заданных переменных  - НЕ ЗНАЮ КАК
3) В папке "Результат" (с подпапками) во всех файлах Word вставить значения на места закладок из заданных переменных - НЕ ЗНАЮ КАК


P.S. Я себе это представляю примерно так: надо перебрать все файлы в папке "Результат" (с подпапками) и в каждом присвоить значение меткам (т.е. ячейкам с присвоенными именами и закладками в ворде) значения заданных соответствующих переменных, но как это сделать не знаю и в инете не нашел.

Помогите, пожалуйста.
То, что уже сделал, прикрепил с сообщению.

[Snekich]

Код Выделить Развернуть


  Sub AllNameAndZakl()

    ' Памятка:
    '
    ' Закладки в файлах word:
    ' LeterDate
    ' LeterName
    ' Имена ячеек в файлах exel:
    ' WorkDate
    ' WorkName
    '
'Присваиваем переменным значения из ячеек
w1 = Worksheets("Work").Range("A2").Value
w2 = Worksheets("Work").Range("B2").Value
L1 = Worksheets("Leter").Range("A2").Value
L2 = Worksheets("Leter").Range("B2").Value

' 1) Скопировать файлы из папки "Шаблоны" в папку "Результат" и присваиваем имена в соответствии с таблицами на листах FileWork и FileLeter

Application.Run "FolderAndFileWork" - все работает
Application.Run "FolderAndFileLeter" - все работает

   
' 2) В екселевских файлах в папке "Результат" вставляем в ячейки соответсвующих имен значения их переменных:
   
        'поочередно открываем файлы и вносим в них изменения
Dim ActiveWorkbook_Path As String
Dim Folder_New As String
Dim FullName As String
Dim i As Long, lLastRow As Long
ActiveWorkbook_Path = ActiveWorkbook.Path
Folder_New = ActiveWorkbook_Path & "\Результат\Work\" 'определяем путь файла
Sheets("FileWork").Select
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю строчку
For i = 3 To lLastRow 'перебираем все имена файлов
FullName = Folder_New & Cells(i, 2) & ".xlsx" 'записываем в переменную полный путь файла и имя с расширением

'Application.ScreenUpdating = False
Set wb = Workbooks.Open(FullName) 'открываем файл
wb.Windows(1).Visible = False 'отключаем показ открытого окна, не забыть включить его перед сохранением

[WorkDate] = w1 'записываем в ячейку с именем WorkDate значение переменной w1
[WorkName] = w2 'записываем в ячейку с именем WorkName значение переменной w2

wb.Windows(1).Visible = True 'включаем показ открытого окна
wb.Close True 'закрываем файл с сохранением
'Application.ScreenUpdating = True

Next i

   
' 3) В водвоских файлах в папке "Результат" вставляем на место закладок значения их переменных:
    'аналогично коду выше, напишу, после того, как налажу код выше
    '[ LeterDate] = L1
    '[LeterName] = L2

End Sub

Что я не так делаю (во втором "пункте" кода) ?
Плюс не пойму почему ошибка в строке: [WorkDate] = w1

[Snekich]

Основу сделал, работает. Буду дорабатывать. Может кому поможет...

Код Выделить Развернуть

Sub AllNameAndZakl()
   
Application.ScreenUpdating = False 'выключаем показ действий
   
    ' Памятка:
    '
    ' Закладки в файлах word:
    ' LeterDate
    ' LeterName
    ' Имена ячеек в файлах exel:
    ' WorkDate
    ' WorkName
    '
'Присваиваем переменным значения из ячеек
w1 = Worksheets("Work").Range("A2").Value
w2 = Worksheets("Work").Range("B2").Value
L1 = Worksheets("Leter").Range("A2").Value
L2 = Worksheets("Leter").Range("B2").Value

' 1) Скопировать файлы из папки "Шаблоны" в папку "Результат" и присваиваем имена в соответствии с таблицами на листах FileWork и FileLeter
Application.Run "NewFolder"
Application.Run "FolderAndFileWork"
Application.Run "FolderAndFileLeter"

   
' 2) В екселевских файлах в папке "Результат" вставляем в ячейки соответсвующих имен значения их переменных:
   
        'поочередно открываем файлы и вносим в них изменения
Dim ActiveWorkbook_Path As String
Dim Folder_Excel As String
Dim FullName As String
Dim i As Long, lLastRowExcel As Long
ActiveWorkbook_Path = ActiveWorkbook.Path 'папка с рабочим файлом
Folder_Excel = ActiveWorkbook_Path & "\Результат\Work\" 'определяем путь файла
Sheets("FileWork").Select
lLastRowExcel = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю строчку
For i = 3 To lLastRowExcel 'перебираем все имена файлов
FullName = Folder_Excel & Cells(i, 2) & ".xlsx" 'записываем в переменную полный путь файла и имя с расширением

Set wb = Workbooks.Open(FullName) 'открываем файл
'wb.Windows(1).Visible = False 'отключаем показ открытого окна, не забыть включить его перед сохранением

[WorkDate].Formula = w1
[WorkName].Formula = w2

'wb.Windows(1).Visible = True 'включаем показ открытого окна
wb.Close True 'закрываем файл с сохранением


Next i

   
' 3) В водвоских файлах в папке "Результат" вставляем на место закладок значения их переменных:
   
Set wa = CreateObject("Word.Application") ' Создаем приложение Word
wa.Visible = True ' делаем Word видимым

Dim Folder_Word As String
Dim lLastRowWord As Long
'ActiveWorkbook_Path = ActiveWorkbook.Path
Folder_Word = ActiveWorkbook_Path & "\Результат\Leter\" 'определяем путь файла
Sheets("FileLeter").Select
lLastRowWord = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю строчку
For i = 3 To lLastRowWord 'перебираем все имена файлов
FullName = Folder_Word & Cells(i, 2) & ".docx" 'записываем в переменную полный путь файла и имя с расширением


Set wd = wa.Documents.Open(FullName) 'открываем файл

wd.Bookmarks("LeterDate").Range.Text = L1
wd.Bookmarks("LeterName").Range.Text = L2

wd.Close True 'закрываем файл с сохранением

Next i

wa.Quit
Set wa = Nothing

Sheets("RunMac").Select
Application.ScreenUpdating = True 'включаем показ действий
End Sub