VBA to take data from excel including the cell colour and paste to word

[Lakhvear WSingh]

Hi all I have created a excel workbook and want to automate the copying of data from it to a word template and populate some bookmarks i have setup in word. Currently only the cell values are being copied but i would like the cell colour to be retained also. This the code i am currently using:

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

    Set ws = ThisWorkbook.Sheets("Sheet1")

    Set objWord = CreateObject("Word.Application")

    objWord.Visible = True

    objWord.Documents.Open "N:\Toby\Assessment\New Assessment Data Sheets\Year 9\Art\test.docx" ' change as required

    With objWord.ActiveDocument
        .Bookmarks("Text1").Range.Text = ws.Range("A2").Value.ActiveCell.DisplayFormat.Interior.Color
        .Bookmarks("Text2").Range.Text = ws.Range("A3").Value
        .Bookmarks("Text3").Range.Text = ws.Range("A4").Value
        .Bookmarks("Text4").Range.Text = ws.Range("A5").Value
        .Bookmarks("Text5").Range.Text = ws.Range("A6").Value
        .Bookmarks("Text6").Range.Text = ws.Range("A7").Value
        .Bookmarks("Text7").Range.Text = ws.Range("A8").Value
        .Bookmarks("Text8").Range.Text = ws.Range("A9").Value
        .Bookmarks("Text9").Range.Text = ws.Range("A10").Value
        .Bookmarks("Text10").Range.Text = ws.Range("A11").Value
        .Bookmarks("Text11").Range.Text = ws.Range("A12").Value
        .Bookmarks("Text12").Range.Text = ws.Range("A13").Value
        .Bookmarks("Text13").Range.Text = ws.Range("A14").Value
        .Bookmarks("Text14").Range.Text = ws.Range("A15").Value
        .Bookmarks("Text15").Range.Text = ws.Range("A16").Value
        .Bookmarks("Text16").Range.Text = ws.Range("A17").Value
        .Bookmarks("Text17").Range.Text = ws.Range("A18").Value
        .Bookmarks("Text18").Range.Text = ws.Range("A19").Value
        .Bookmarks("Text19").Range.Text = ws.Range("A20").Value
        .Bookmarks("Text20").Range.Text = ws.Range("A21").Value
        .Bookmarks("Text21").Range.Text = ws.Range("A22").Value
        .Bookmarks("Text22").Range.Text = ws.Range("A23").Value
        .Bookmarks("Text23").Range.Text = ws.Range("A24").Value
        .Bookmarks("Text24").Range.Text = ws.Range("A25").Value
        .Bookmarks("Text25").Range.Text = ws.Range("A26").Value
        .Bookmarks("Text26").Range.Text = ws.Range("A27").Value
        .Bookmarks("Text27").Range.Text = ws.Range("A28").Value
        .Bookmarks("Text28").Range.Text = ws.Range("A29").Value
       
        .Bookmarks("Text41").Range.Text = ws.Range("B2").Value
        .Bookmarks("Text42").Range.Text = ws.Range("B3").Value
        .Bookmarks("Text43").Range.Text = ws.Range("B4").Value
        .Bookmarks("Text44").Range.Text = ws.Range("B5").Value
        .Bookmarks("Text45").Range.Text = ws.Range("B6").Value
        .Bookmarks("Text46").Range.Text = ws.Range("B7").Value
        .Bookmarks("Text47").Range.Text = ws.Range("B8").Value
        .Bookmarks("Text48").Range.Text = ws.Range("B9").Value
        .Bookmarks("Text49").Range.Text = ws.Range("B10").Value
        .Bookmarks("Text50").Range.Text = ws.Range("B11").Value
        .Bookmarks("Text51").Range.Text = ws.Range("B12").Value
        .Bookmarks("Text52").Range.Text = ws.Range("B13").Value
        .Bookmarks("Text53").Range.Text = ws.Range("B14").Value
        .Bookmarks("Text54").Range.Text = ws.Range("B15").Value
        .Bookmarks("Text55").Range.Text = ws.Range("B16").Value
        .Bookmarks("Text56").Range.Text = ws.Range("B17").Value
       
        .Bookmarks("Text58").Range.Text = ws.Range("B18").Value
        .Bookmarks("Text59").Range.Text = ws.Range("B19").Value
        .Bookmarks("Text60").Range.Text = ws.Range("B20").Value
        .Bookmarks("Text61").Range.Text = ws.Range("B21").Value
        .Bookmarks("Text62").Range.Text = ws.Range("B22").Value
        .Bookmarks("Text63").Range.Text = ws.Range("B23").Value
        .Bookmarks("Text64").Range.Text = ws.Range("B24").Value
        .Bookmarks("Text65").Range.Text = ws.Range("B25").Value
        .Bookmarks("Text66").Range.Text = ws.Range("B26").Value
        .Bookmarks("Text67").Range.Text = ws.Range("B27").Value
       

    End With

    Set objWord = Nothing

End Sub

 

[SirJB7]

Hi, Lakhvear WSingh!

Welcome to Chandoo forums!
Checked this yet?
http://chandoo.org/forum/forums/new-users-please-start-here.14/

About your question, consider uploading sample files, specially the Word document. It'd be easier to understand for people who might be able to help you.
Include indication of the input data, the attempted solution (formulas, code) and the manually written expected output data as example. Thanks.

Regards!