Dim iLastRowNal As Long, I As Long
Dim iLastRowArhiv As Long
Dim Ip As String

    iLastRowNal = Cells(Rows.Count, 12).End(xlUp).Row
         
       MsgBox iLastRowNal
        
    For I = 3 To iLastRowNal
         If Cells(I, 12) = FirmUnic Then
       
            iLastRowArhiv = Sheets("Dog1").Cells(Rows.Count, 12).End(xlUp).Row + 1
            
            MsgBox iLastRowArhiv
            
            Range(Cells(I, 1), Cells(I, 12)).Copy
            Sheets("Dog1").Cells(iLastRowArhiv, 1).PasteSpecial Paste:=xlPasteValues
'            Range(Cells(i, 2), Cells(i, 7)).ClearContents
        End If
     ' MsgBox FirmUnic
     Next I
       
     
    Application.CutCopyMode = False
    
 

Чтобы работать с запущенной программой Word,
'надо использовать GetObject.
Set Ворд = GetObject(Class:="Word.Application")
'Подключение к активному документу Word.
Set Документ = Ворд.ActiveDocument
'Копирование диапазона ячеек из активной книги, из активного листа Excel.

          Dim iLastDog1 As Long
             iLastDog1 = Cells(Rows.Count, 10).End(xlUp).Row 'вычисление номера строки
           

        ActiveWorkbook.Sheets("Dog1").Range(Cells(2, 1), Cells(iLastDog1 - 1, 11)).Copy

   
'Вставка скопированного в закладку с именем Закладка1.

'WordFormatting:=True - шрифт текста вставленной таблицы будет в соответствии со стилем Сетка таблица, а не как в Excel.
'RTF:=True - таблица будет использовать RTF, а не HTML (этого сам не понимаю).
Документ.Bookmarks("Таблица").Range.PasteExcelTable _
    LinkedToExcel:=False, WordFormatting:=True, RTF:=False

'Снятие пунктирной линии в Excel после копирования.
Application.CutCopyMode = False

End Sub

Sub ToWords()
'Перенос в закладку ворд

Dim iLastDog1 As Long


   Sheets("Dog1").Select ' активируем лист с таблицей

  With ActiveDocument
  
               Set r = ActiveDocument.Bookmarks.Item("Таблица").Range
                      n = r.Start
                If r.End - r.Start > 10 Then
                      Set Q = .Range(r.Start + 1, r.End)
                      Q.Tables(1).Delete
                End If
           
                With Sheets("Dog1") 'для листа на котором динамическая таблица для копирования

                    iLastDog1 = Cells(Rows.Count, 10).End(xlUp).Row 'вычисление номера последней строки
               
                     Range(Cells(2, 1), Cells(iLastDog1, 11)).Copy 'копируем динамическую таблицу зная столбцы
                  
               End With
      
      r.PasteAndFormat (wdFormatOriginalFormatting)
      ActiveDocument.Bookmarks.Add "Таблица", r           'вставляем в закладку ворд
          
   End With
    
End Sub

MsgBox Application.Min(ActiveSheet.Range("H3,K3,N3"))

MsgBox Application.Min(ActiveSheet.Range(Cells(6, 3), Cells(8, 3), Cells(10, 3)))

Sub W140228_1404()
Dim j1, j2, s1, s2, JX, F5

JX = Excel.ActiveCell.Row
Dim zpath As String
Dim zname As String
Dim App As Word.Application     ' Приложение программы
    Dim str As String               ' Имя базы данных
    Dim rng As Word.Range           ' Область данных
    Dim tbl As Word.Table           ' Таблица документа
    Dim c As Word.Cell              ' Ячейка таблицы
    Set App = New Word.Application
    App.Visible = True
    zpath = Excel.ActiveWorkbook.Path & "\"
    
    UserForm2.Show
           
    App.Documents.Add zpath & "ДОГОВОР" & F5 & ".DOTX"
    
    'CurrentProject.Path & "\Шаблоны\Шаблон.dot"
' ---------------------------- Формирование запроса

' ----------------------------
   
    Set rng = App.ActiveDocument.Range ' Выбираем закладку (позицию) таблицы
    j1 = 0
    Do While j1 < 13
    j1 = j1 + 1
    s1 = "{" & Cells(1, j1) & "}"
    s2 = Cells(JX, j1)
    Debug.Print j1, s1, s2
    If Len(s1) > 3 Then
    rng.Find.ClearFormatting
    rng.Find.Replacement.ClearFormatting
    With rng.Find
        .Text = s1
        .Replacement.Text = s2
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    rng.Find.Execute Replace:=wdReplaceAll
End If
Loop
App.ActiveDocument.SaveAs zpath & Cells(JX, 1) & Format(Now, "YYYY-MM-DD_HH-MM-SS") & ".DOCX"
''Format(Now, "YYYY-MM-DD_HH-MM-SS.DOCX")
End Sub

Private Sub CommandButton1_Click()
 Public F5
     If OptionButton1.Value = True Then
     F5 = 1
      MsgBox F5
       End If
       If OptionButton2.Value = True Then
       F5 = 2
       MsgBox F5
        End If
       If OptionButton3.Value = True Then
       F5 = 3
       MsgBox F5
        End If
       If OptionButton4.Value = True Then
       F5 = 4
       MsgBox F5
        End If
       If OptionButton5.Value = True Then
       F5 = 5
       MsgBox F5
   End If
    
UserForm2.Hide
End Sub

 .Bookmarks.Item("bookmark_1").Range.Text = IIf(IsNull(Sheets(1).Cells(1, 1).Value), "", Sheets(1).Cells(1, 1).Value)

Then