Нашёл что-то похожее,но надо допиливать
[vba]Код
Sub discharge()
Dim objWord As Object
Dim File_Name As String
Dim FileSt As String
Dim FileNew As String
Dim MyLink As Object
Set objWord = CreateObject("Word.Application")
File_Name = Range("C2").Value
FileSt = "D:\\Новая папка\\Шаблон.docx"
FileNew = "D:\Новая папка\\" & File_Name & ".docx"
objWord.Documents.Open FileSt
For Each MyLink In objWord.ActiveDocument.Fields
MyLink.Update
MyLink.Unlink
Next MyLink
objWord.ActiveDocument.SaveAs _
Filename:=FileNew, _
FileFormat:=wdFormatDocument, _
Password:="", _
AddToRecentFiles:=True, _
WritePassword:="", _
ReadOnlyRecommended:=False
objWord.Quit
End Sub
[/vba]