To find word in Microsoft Word Table and copy Offsets to Excel Cells

[johngalvin]

Hey guys
The problem is sort of solved, but can anyone please help out with copying directly the field from the Word Document( from the next column from the Word Table )without the Pilcrow symbol to Excel Cell? At the moment it is copying the field from the Word Table with a Pilcrow symbol to Excel, then it deletes it. Is there any way to copy directly without symbol (pilcrow)?

Option Explicit

Sub WordTabletoExcel()
Dim WrdApp AsObject, Cnt AsInteger, FileStr AsString
Dim WrdDoc AsObject, TblCell AsVariant
Dim FSO AsObject, FolDir AsObject, FileNm AsObject
OnErrorGoTo ErFix
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible =False
Set FSO = CreateObject("scripting.filesystemobject")
Set FolDir = FSO.GetFolder("C:\Users\John\Desktop\Fruits")
'loop files
ForEach FileNm In FolDir.Files
    If FileNm.Name Like"*"&".docx"Then
         FileStr =CStr(FileNm)
         Set WrdDoc = WrdApp.Documents.Open(FileStr)
         'check if table exists
         If WrdApp.ActiveDocument.Tables.Count <1Then
             GoTo Below
         End If
Dim SearchWord AsString
        SearchWord ="Fruits"
For Cnt =1To WrdApp.ActiveDocument.Tables.Count
             'loop through table cells
             ForEach TblCell In WrdApp.ActiveDocument.Tables(Cnt).Range.Cells
                 If InStr(TblCell.Range, SearchWord)Then
                     'remove pilcrow
                     Sheets(Sheet1").Range("A" & 1) = WrdApp.ActiveDocument.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1)
                     Sheets("Sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("Sheet1").Range("A" & 1))
                End If
          Next TblCell
     Next Cnt
 End Sub

This is how it is currently copying
https://imgur.com/Mbtw5Iz
And after a while it deletes that symbol

Was wondering if it could copy directly from Word table to Excel Cell without involving symbol and then deleting it.


Many thanks

John