Подстановка данных из экселя в ворд

[krot12348]

Не все данные вставляются в ворд из таблицы экселя, голову сломал
ОС-Виндовс 10
Офис 2013г

макрос для ворда

Sub paste()
    Selection.HomeKey Unit:=wdStory, Extend:=wdMove

    With Selection.Find
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting

End Sub

Макрос для экселя

Sub автозамена()
Dim word As Object
Dim wl As Worksheet
Dim patch, name As String

Dim rWhat, rTo As String



Set wl = Workbooks(1).Worksheets(1)
Set word = CreateObject("Word.Application")
iPath = ActiveWorkbook.Path + "\"

Dim i, j As Integer
 i = 1
 j = 1

wl.Activate
While (wl.Cells(i + 1, 1) <> "")
   Set word = CreateObject("Word.Application")
   word.Visible = True
   word.Activate
   word.Documents.Open Filename:=iPath + "ШаблонЗаключение.docx", ReadOnly:=False
   word.Visible = True
   word.Activate
   j = 1
  While (wl.Cells(i + 1, j + 1) <> "")
    'word.Selection.HomeKey ' Unit:=wdStory, Extend:=wdMove
    wl.Activate
    word.Activate
     rWhat = Cells(1, 1 + j)
     rTo = Cells(i + 1, j + 1)
     word.Selection.Find.ClearFormatting
     word.Selection.Find.Replacement.ClearFormatting
     word.Selection.Find.Execute FindText:=rWhat, _
     ReplaceWith:=rTo, Replace:=wdReplaceAll
     word.Run "paste"
  
    j = j + 1
    
    Wend
    NameFile = iPath & Cells(i + 1, 1).Text & ".docx"
    word.ActiveDocument.SaveAs Filename:=NameFile
    word.ActiveDocument.Close
    word.Quit
    
    i = i + 1
   
    
Wend

End Sub

Таблица в эксель
Программашаблон.rar

Документ ворд
1234567.docx

проблема со вставкой данных в колонке dataprov
и колонке datdiag

пробывал переименовать, результат ноль
может кто поможет.

[EducatedFool]

Попробуйте готовое решение для подобных задач:
http://excelvba.ru/programmes/FillDocuments
Там одну кнопку только нажать нужно будет