自分用です。タイトル通りです。

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

 

おすすめの記事