Need vba code to export row values into msword file with new file name|VBA & Macros|Excel Forum|My Online Training Hub

Sub SendExcelDataToWord()
Dim Tbl As Excel.Range, x As Byte, WdTbl As Object
Dim WordApp As Object, ExitPoint As Label
Dim myDoc As Object
Dim BookmarkArray As Variant

BookmarkArray = Array("RangeName1", "RangeName2", "RangeName3") ' excel named ranges to transfer into same ContentControl names
Application.ScreenUpdating = False
Application.EnableEvents = False

Set myDoc = GetWordDocument( "E:\Docs\WordDocName.docx")
if mydoc is nothing then goto ExitPoint
For x = LBound(BookmarkArray) To UBound(BookmarkArray)
If myDoc.SelectContentControlsByTitle(BookmarkArray(x)).Count = 0 Then
MsgBox "Content Control not found: ''" & BookmarkArray(x) & "''."
Else
Set Tbl = ThisWorkbook.Names(BookmarkArray(x)).RefersToRange ' if there is no such range name, code will fail, error is not handled
Tbl.Copy
myDoc.SelectContentControlsByTitle(BookmarkArray(x))(1).Range.Text = ""
myDoc.SelectContentControlsByTitle(BookmarkArray(x))(1).Range.PasteAndFormat (22) '10 is wdTableAppendTable

End If

Next x

ExitPoint:
Set myDoc = Nothing
Set Tbl = Nothing
Set WdTbl = Nothing

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.CutCopyMode = False

End Sub

Function GetWordDocument(ByVal DocPath As String) As Object
Dim Fname As String, BMRange As Object, Cell As Range, NotOpen As Label, OpenAlready As Label, FilePath As String
Dim WdApp As Object, WdDoc As Object, i As Integer, Nm As String, ExitLine As Label
ChDir ThisWorkbook.Path
FilePath = Left(DocPath, InStrRev(DocPath, "\"))
Fname = Replace(DocPath, FilePath, "")
'try to open it, it might be in the right place
Application.DisplayAlerts = False
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If WdApp Is Nothing Then Set WdApp = CreateObject("Word.Application")
Set WdDoc = WdApp.Documents(Fname)
If WdDoc Is Nothing Then Set WdDoc = WdApp.Documents.Open(DocPath)
If WdDoc Is Nothing Then
Fname = Application.GetOpenFilename("Word files (*.do*),*.do*", , "Select " & Fname & " (Word document)")
If Fname = "False" Then Exit Function
FilePath = Left(Fname, InStrRev(Fname, "\"))
Set WdDoc = WdApp.Documents.Open(Fname)
End If
On Error GoTo 0

Application.DisplayAlerts = True
WdApp.Visible = True
Set GetWordDocument = WdDoc

End Function