Hi all,

I currently have 2 x codes to copy data from an excel spreadsheet into a word template when a command button on a userform is selected. The two codes are to paste text and pictures.

Sub Procedure1()
Dim objWord As Object
Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet6")

    Set objWord = CreateObject("Word.Application")

    objWord.Visible = True

    objWord.Documents.Open "C:\Users\Christopher.Ellis\Desktop\VBA Testing\CPA Test\Test1.docx" ' change as required

    With objWord.ActiveDocument
        .Bookmarks("C1").Range.Text = ws.Range("C25").Value
        .Bookmarks("C2").Range.Text = ws.Range("C25").Value
        .Bookmarks("Co1").Range.Text = ws.Range("C26").Value
        .Bookmarks("Cl1").Range.Text = ws.Range("C27").Value
        .Bookmarks("Ex_1").Range.Text = ws.Range("C28").Value
        .Bookmarks("Ex_2").Range.Text = ws.Range("C28").Value
        .Bookmarks("S1").Range.Shading.BackgroundPatternColor = ws.Range("C29").Interior.Color
        .Bookmarks("S2").Range.Shading.BackgroundPatternColor = ws.Range("C29").Interior.Color
        .Bookmarks("S3").Range.Shading.BackgroundPatternColor = ws.Range("C29").Interior.Color
        .Bookmarks("S3").Range.Shading.BackgroundPatternColor = ws.Range("C29").Interior.Color
        .Bookmarks("S1").Range.Font.ColorIndex = ws.Range("C29").Font.ColorIndex
        .Bookmarks("S2").Range.Font.ColorIndex = ws.Range("C29").Font.ColorIndex
        .Bookmarks("S3").Range.Font.ColorIndex = ws.Range("C29").Font.ColorIndex
        .Bookmarks("S4").Range.Font.ColorIndex = ws.Range("C29").Font.ColorIndex
        .Bookmarks("S1").Range.Text = ws.Range("C29").Value
        .Bookmarks("S2").Range.Text = ws.Range("C29").Value
        .Bookmarks("S3").Range.Text = ws.Range("C29").Value
        .Bookmarks("S4").Range.Text = ws.Range("C29").Value
  
      
    .Save
    .Close
        
    End With
 
    Set objWord = Nothing


End Sub
Sub Procedure2()
'   Excel parameters
    Const sSHEET_NAME       As String = "Sheet6"

'   Word parameters
    Const sTARGET_PATH      As String = "C:\Users\Christopher.Ellis\Desktop\VBA Testing\CPA Test\"
    Const sTARGET_NAME      As String = "GR1 CPA Test1.docx"

    Dim sBookmarkName       As String
    Dim sRangeToCopy        As String
    Dim vaDataValues        As Variant
    Dim objWord             As Object
    Dim iRowNo              As Integer
    Dim wks                 As Worksheet

    ReDim vaDataValues(1 To 4, 1 To 2)

    vaDataValues(1, 1) = "B2:G23"
    vaDataValues(1, 2) = "CW1"
    vaDataValues(2, 1) = "I25:P35"
    vaDataValues(2, 2) = "C1"
    vaDataValues(3, 1) = "D2"
    vaDataValues(3, 2) = "D2"
    vaDataValues(4, 1) = "I2"
    vaDataValues(4, 2) = "I2"
    

    Set objWord = CreateObject("Word.Application")

        objWord.Visible = True

        objWord.Documents.Open sTARGET_PATH & sTARGET_NAME

    Set wks = ThisWorkbook.Sheets(sSHEET_NAME)

        For iRowNo = LBound(vaDataValues, 1) To UBound(vaDataValues, 1)

            sRangeToCopy = vaDataValues(iRowNo, 1)
            sBookmarkName = vaDataValues(iRowNo, 2)

            wks.Range(sRangeToCopy).CopyPicture

            objWord.ActiveDocument.Bookmarks(sBookmarkName).Range.Paste
 
        Next iRowNo
 
    Set objWord = Nothing
    Set wks = Nothing

End Sub
Currently once the codes have been run and the word document is produced I save it somewhere and then if I need to do it again with different data, I have to delete the original word template and replace it with a master copy, as the bookmarks are deleted.

Is there a way of getting around this? I.e. not deleting the bookmarks?