エクセルからワードに書き出すマクロを教えてください。

質問

仕事でエクセルデータをワードに書き出すことが必要になりました。出力先のワードは、フォーマットが固定されています。エクセルで抽出したリストから各項目を、ワードの罫線で作った表に書き出したいのです。（エクセルをワードに挿入・表の貼付けをするのではなく、データを個別に書き出していきたいのです。）
具体的なイメージは次のとおりです。
　　Ａ　　　　Ｂ　　Ｃ　　　Ｄ　　　　←列
１　あああ　○○　09/04　5,000円
２　いいい　△△　09/05　6,000円
３　ううう　□□　09/06　7,000円
↑行

こちらの回答からエクセルからワードに書き出すことはできたのですが、ワードの表への書き出しが解決できませんでした。
どうかご教授ください。よろしくお願いいたします。

回答No.2

Wendy02

こんばんは。

ご質問者さんは、ここは初めてではないかと思います。参考にされたコードがどんなものか分かりませんが、Wordのドキュメント上に、表が作られているという前提のコードです。Excel上の表と同じ大きさか、Word側の表が大きいことが前提です。

'Excelの標準モジュールが良いです。

Sub TransferTable()
　　Dim objWd As Object　'Word.Application
　　Dim wdDoc As Object　 'Word.Document
　　Dim wdTable As Object 'Word.Table
　　Dim y As Long
　　Dim x As Long
　　Dim i As Long
　　Dim j As Long
　　Dim rng As Range
　　Const vbMyError As Integer = 513 'ユーザー設定エラー

　　 Set rng = Worksheets("Sheet1").Range("A1:D3") 'Excelのデータ範囲
　　Const FNAME = "D:\Test.doc"　'Word のファイル名

　　On Error GoTo ErrHandler
　　Set objWd = CreateObject("Word.Application")
　　objWd.Visible = True
　　Set wdDoc = objWd.Documents.Open(FNAME)
　　If wdDoc.Tables.Count = 0 Then
　　　 MsgBox "表が存在しません。", vbCritical
　　　 Err.Raise vbMyError
　　End If
　　Set wdTable = wdDoc.Tables(1)

　　x = wdTable.Columns.Count
　　y = wdTable.Rows.Count
　　For j = 1 To x
　　　　For i = 1 To y
　　　　　　wdTable.Cell(i, j).Range.Text = rng.Cells(i, j).Text
　　　　Next i
　　Next j
　　wdDoc.Save
ErrHandler:
　　If Err.Number > 0 Then
　　　 MsgBox Err.Number & " :　" & Err.Description, vbInformation
　　 End If
　　wdDoc.Close
　　objWd.Quit
　　Set wdTable = Nothing
　　Set wdDoc = Nothing
　　Set objWd = Nothing
End Sub

回答No.1

noname#99913

ワードの表の各セルに、エクセルの該当するセルへのリンクを張ればいいのではないでしょうか。

(1)エクセルの該当するセルにセルカーソルを移動
(2)Ctrl＋C
(3)ワードの表の該当するセルにカーソルを移動
(4)形式を選択して貼り付け
(5)左の「リンク貼り付け」にチェック
(6)「貼り付ける形式」を「テキスト」に
(7)OK