自分用です。タイトル通りです。
Sub CopyWordTableCellToExcelCell()
Dim wdApp As Object ' Word.Application
Dim wdDoc As Object ' Word.Document
Dim wordFilePath As String
Dim wordText As String
' Wordファイルのパスを指定
wordFilePath = "Desktop\hoge\SampleWordTable.docx" ' 実際のファイルパスに置き換えてください
' Wordを起動
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False ' 必要に応じてTrueに
' Wordファイルを開く
Set wdDoc = wdApp.Documents.Open(wordFilePath)
' Wordの表のセル(2行目、2列目)のテキストを取得(1つ目の表を想定)
With wdDoc.Tables(1).Cell(2, 2)
' セル内のテキストから末尾の改行記号を削除し、改行をvbLfに変換
wordText = Replace(.Range.Text, vbCr, vbLf)
wordText = Left(wordText, Len(wordText) - 2) ' セル末尾の2文字削除(セルの終了記号)
End With
' Excelのセルに1つのセルとして貼り付け
With ThisWorkbook.Sheets(1).Range("A1")
.Value = wordText
.WrapText = True ' セル内改行を見やすく表示
End With
' 後処理
wdDoc.Close SaveChanges:=False
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub