How to populate cell contents from excel into word using bookmarks

In the event that you want to populate information contained in an excel file to a word document using bookmarks, see the code below (this could be looped and used as a type of mail merge):

Sub PopulateToWordBookmark()
'Set up the cells that you want to use
'to populate bookmark data

Dim cName as Range, cAddress as Range, _
cCity as Range, cState as Range, cZip as Range
Set cName = Range("A2")
Set cAddress = Range("B2")
Set cCity = Range("C2")
Set cState = Range("D2")
Set cZip = Range("E2")

Dim NewApp As Object
Dim NewDoc As Object
    On Error Resume Next
    Set NewApp = GetObject(, "Word.Application")
    If NewApp Is Nothing Then
        Set NewApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0 ' resume normal error handling
     If NewApp is Nothing Then
          MsgBox("This file is probably already open." & _
               "If so, please close it.")
     End If
    With NewApp
        .Visible = True

'Set the file location below to the document that
'you want to add content to.
        Set NewDoc = .Documents.Open("C:\Temp\Doc1.docx")

        With NewDoc
'Change the bookmark names below to your bookmark names
                .Bookmarks("Name").Range.Text = cName.Text
                .Bookmarks("Address").Range.Text = cAddress.Text
                .Bookmarks("City").Range.Text = cCity.Text
                .Bookmarks("State").Range.Text = cState.Text
                .Bookmarks("Zip").Range.Text = cZip.Text
         End With

'The code below will save and close your updated document

         NewDoc.SaveAs Filename:="Doc1.docx", _
                  FileFormat:= wdFormatXMLDocument, _
                  LockComments:=False, Password:="", _
                  AddToRecentFiles:=True, WritePassword:="", _
                  ReadOnlyRecommended:=False, _
                  EmbedTrueTypeFonts:=False, _
                  SaveNativePictureFormat:=False, _
                  SaveFormsData:=False, _
                  SaveAsAOCELetter:=False
         NewDoc.Close


    End With
    Set NewDoc = Nothing
    Set NewApp = Nothing
End Sub

Special thanks once again to:
erlandsendata