Keep Excel text formatting when transferring data to Word with Excel VBA

[BURTPRI]

Hi Guys!

I'm using the following Excel VBA code to generate a WordDoc and then transfer text from my ExcelDoc to the WordDoc:

Sub Generate_WordDoc()

Dim WordDoc As Object
Dim FileName, TagName, TagValue As String
Dim CustRow As Long
Dim WordContent As Word.Range

With Sheet1
Set wordapp = CreateObject("Word.Application")
      wordapp.Visible = True   
    Set WordDoc = wordapp.Documents.Open(FileName:="C:\File location\Name of file.docx", ReadOnly:=False)
        For CustRow = 2 To 4
        TagName = .Cells(CustRow, 1).Value
        TagValue = .Cells(CustRow, 2).Value
        With WordDoc.Content.Find
        .Text = TagName
        .Replacement.Text = TagValue
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
        End With
        Next CustRow     
 
End With
End Sub

It would work perfectly if wasn't by the fact that my WordDoc doesn't keep important formatting like paragraphs and bold text, as you can see in the images below:

-> What I have in my WordDoc:

Please note that in my WordDoc template I have only the start text (it's not merge fields, it's only text itself):
Company: <<Company>>
Address: <<Address>>
Phone: <<Phone number>>

I guess I need a "paste special" code or something like that but I can't find it...

Also, and if possible, I would like to not show in my WordDoc the text "Company: " if there's no Value on cell B2 of my ExcelDoc.

Hopefully someone will be able and kind to help me with this challenge.

If you read this far, thank you very much!

 

[BURTPRI]

I've also posted it here Keep Excel text formatting when transferring data to Word with Excel VBA as no one answered here.

 

[Macropod]

I've also posted it here Keep Excel text formatting when transferring data to Word with Excel VBA as no one answered here.

Not exactly patient, are you?

 

[Macropod]

Change:
TagValue = .Cells(CustRow, 2).Value
to:
.Cells(CustRow, 2).Copy
Change:
.Replacement.Text = TagValue
to:
.Replacement.Text = "^c"

 

[BURTPRI]

Change:
TagValue = .Cells(CustRow, 2).Value
to:
.Cells(CustRow, 2).Copy
Change:
.Replacement.Text = TagValue
to:
.Replacement.Text = "^c"

Thank you very much for your suggestion Paul but it completely changes my WordDoc structure bringing the Excel cell structure.

What I need is just regarding the formatting of the text value I'm bringing to Word, you know?

 

[BURTPRI]

Not exactly patient, are you?

I apologize I have a very tight deadline.

 

[BURTPRI]

Thank you very much for your suggestion Paul but it completely changes my WordDoc structure bringing the Excel cell structure.

What I need is just regarding the formatting of the text value I'm bringing to Word, you know?

Or maybe how it would be this code but only for cell B3? It's the only cell I have paragraph actually.

 

[Macropod]

Try:

Sub Generate_WordDoc()
Dim TagName As String, CustRow As Long
Dim WordApp As Word.Application, WordDoc As Word.Document
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(FileName:="C:\File location\Name of file.docx", ReadOnly:=False)
With Sheet1
  For CustRow = 2 To 4
    TagName = .Cells(CustRow, 1).Value
    .Cells(CustRow, 2).Copy
    With WordDoc.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = TagName
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
      End With
      Do While .Find.Execute
        .PasteAndFormat wdUseDestinationStylesRecovery
        .Collapse wdCollapseEnd
      Loop
    End With
  Next CustRow
End With
End Sub

 

[BURTPRI]

Try:

Sub Generate_WordDoc()
Dim TagName As String, CustRow As Long
Dim WordApp As Word.Application, WordDoc As Word.Document
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(FileName:="C:\File location\Name of file.docx", ReadOnly:=False)
With Sheet1
  For CustRow = 2 To 4
    TagName = .Cells(CustRow, 1).Value
    .Cells(CustRow, 2).Copy
    With WordDoc.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = TagName
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
      End With
      Do While .Find.Execute
        .PasteAndFormat wdUseDestinationStylesRecovery
        .Collapse wdCollapseEnd
      Loop
    End With
  Next CustRow
End With
End Sub

"Compile error: User-defined type not defined"

 

[Macropod]

On what line?