Copy formatted text from excel to word - excel

Question

I have an excel sheet with two columns of strings. I track the changes of these two columns using ms-word and copy the result back to a third column. Then I copy the third column to a new word document.
The formating in Excel in Cell C3 is what I would like to transfer to word.
This is what I get at the moment. Notice the complete strike-through.
Why does it work twice but not in the third case?
I guess the root of the problem is that I remove the CR/Linefeed in the word to excel step and destroy the boundary of the strike-through-format. My goal is to get each string in one word-paragraph. If I don't remove the CR/Linefeed i get four paragraphs.
Background: In the final application the strings are going to be paragraphs of text.
Sourcecode of the excel-vba-macro (Excel 2010):
Technical remark: You may need to activate the ms-word-objects in excel-vba. (Microsoft Word 14.0 Object Library )
The macro assumes, that there a strings in the Range(A1:B3):
for example
a string a string, too
a string a new string
a string there is no try
The results will be put in the Range(C1:C3).
Option Explicit
Dim numberOfBlocks As Long
Sub main()
Dim i As Long
Dim tSht As Worksheet
Dim wordapp As Word.Application
Dim wdoc As Word.Document
Set tSht = ThisWorkbook.ActiveSheet
numberOfBlocks = 3
Application.ScreenUpdating = False
Set wordapp = CreateObject("Word.Application")
For i = 1 To numberOfBlocks
Call trackChanges(i, wordapp, tSht)
Next i
Set wdoc = wordapp.Documents.Add
Call copyChanges(tSht, wdoc)
End Sub
Sub trackChanges(i As Long, wordapp As Word.Application, tSht As Worksheet)
Dim diffDoc As Word.Document
Dim textString() As Variant
Dim j As Long
ReDim doc(2)
ReDim textString(2)
Set textString(1) = tSht.Range("A" & i)
Set textString(2) = tSht.Range("B" & i)
For j = 1 To 2
With wordapp
Set doc(j) = .Documents.Add
textString(j).Copy
doc(j).Paragraphs(1).Range.PasteSpecial
End With
Next j
wordapp.CompareDocuments OriginalDocument:=doc(1), RevisedDocument:=doc(2), _
Destination:=wdCompareDestinationNew, Granularity:=wdGranularityCharLevel
For j = 1 To 2
doc(j).Close SaveChanges:=False
Next j
Set diffDoc = wordapp.ActiveDocument
wordapp.Visible = True
'if the answer has two paragraphs, get both in one paragraph
With diffDoc.Content.Find
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Text = vbCrLf
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
End With
diffDoc.Range.Copy
tSht.Range("C" & i).Select
tSht.PasteSpecial Format:="HTML"
With tSht.Range("C" & i)
.WrapText = True
.Font.Name = textString(2).Font.Name
.Font.Bold = textString(2).Font.Bold
.Font.Size = textString(2).Font.Size
.Rows.AutoFit
.Interior.Color = textString(2).Interior.Color
End With
diffDoc.Close SaveChanges:=False
Application.CutCopyMode = False
Set diffDoc = Nothing
End Sub
Sub copyChanges(tSht As Worksheet, wdoc As Word.Document)
tSht.Range("C1:C" & numberOfBlocks).Copy
wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML
wdoc.Tables(1).ConvertToText Separator:=wdSeparateByParagraphs
End Sub