Нажать Alt+F11 и перейти на окошко magic.xls - Module1 (Code), Находим строчку wordGen08 найти такие же строки

Старые строчки выделены красным - их все удалить

Новые строчки (вместо красного)

Sub wordGen08(funcName As String)
 'MsgBox (funcName)
 If funcName <> "" Then
  Dim template0 As Object, doc As Object, x As Range, y As Range
  Dim MyPath As String
  MyPath = ActiveWorkbook.Path
  If Len(Dir(MyPath & "\" & funcName, vbDirectory)) = 0 Then
   MkDir MyPath & "\" & funcName
  End If
  Set wrd = CreateObject("word.application")
  'wrd.Visible = True
  'For Each x In Range(Range("A2"), Range("A1").End(xlDown))
  Dim rng As Range
  Dim firstRow As Long, lastRow As Long
  firstRow = Selection.Rows(1).Row
  lastRow = Selection.Rows.Count + firstRow - 1
  'MsgBox firstRow & "  " & lastRow
  Dim name0 As String, name1 As String, name2 As String
  
  For Each x In Range(Range("A" & firstRow), Range("A" & lastRow))
   name0 = funcName & "0.doc"
   name1 = x.Text & ".doc"
   name2 = funcName & "2.doc"
   If Dir(MyPath & "\" & funcName & "1\" & name1) = "" Then
    MsgBox "Нет шаблона " & name1
    Set template0 = Nothing
    wrd.Quit
    Set wrd = Nothing
    Exit Sub
   End If
   Set template0 = wrd.Documents.Open(Filename:=MyPath & "\" & name0, ConfirmConversions:=False, ReadOnly:=True)
   wrd.Selection.EndKey Unit:=6 'wdStory
   wrd.Selection.InsertFile Filename:=MyPath & "\" & funcName & "1\" & name1
   wrd.Selection.EndKey Unit:=6 'wdStory
   wrd.Selection.InsertFile Filename:=MyPath & "\" & name2
   
   For Each y In Range(x, Cells(x.Row, 256).End(xlToLeft))
    'MsgBox (y.Text)
    With template0.Range.Find
     .ClearFormatting
     .Replacement.ClearFormatting
     .Text = "#" & y.End(xlUp) & "#"
     .Replacement.Text = y.Text
     .Forward = True
     .Wrap = 1 'wdFindContinue
     .Format = False
     .MatchCase = False
     .MatchWholeWord = False
     .Execute Replace:=2 'wdReplaceAll
    End With
   Next
   template0.SaveAs MyPath & "\" & funcName & "\" & x.Text & ".doc"
   template0.Close False
  Next
  Set template0 = Nothing
  wrd.Quit
  Set wrd = Nothing
 End If
End Sub