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

[johngalvin]

Hello Paul
That was quick, thanks!
I tried what you've suggested, the cell remains blank unfortunately.
This is now the code:

Dim SearchWord As String
SearchWord = "Fruits"
For Cnt = 1 To WrdApp.ActiveDocument.Tables.Count
    'loop through table cells
    For Each TblCell In WrdApp.ActiveDocument.Tables(Cnt).Range.Cells
        If InStr(TblCell.Range, SearchWord) Then
            Sheets("Sheet1").Range("A" & 1) = Split(WrdDoc.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1), vbCr, 0)
            Sheets("Sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("Sheet1").Range("A" & 1))
        End If
    Next TblCell
Next Cnt

The issue is that now it doesen't fill anymore the Cell A1, with anything. It used to put there the text with the symbol at the end and then delete the symbol after like 5-10 seconds or so, but it could be better if this could be done in 1 step, directly putting the text into cell without symbol and without the need to delete the symbol

John