Option Explicit

Sub CopyToWord()

    '■変数宣言
    'Wordアプリケーションオブジェクト
    Dim wordApp As Word.Application
    'Wordファイルの格納パス
    Dim wordPath As String
    'コピー元Wordファイル名
    Dim sourceWordName As String
    '新規Wordファイル名
    Dim newWordName As String
    '新規Wordドキュメントオブジェクト
    Dim wordObj As Word.Document

    'Excelデータ取得用
    Dim br As Long
    Dim er As Long
    Dim bc As Long
    Dim ec As Long
    Dim mr As Long
    Dim n1 As Integer
    Dim n2 As Integer
    Dim n3 As Integer
    Dim targetData() As String
    Dim findData() As String

    Dim i, j, k, l, n, m, o As Integer

    '■処理
    'Wordアプリケーションオブジェクトの用意
    Set wordApp = CreateObject("Word.Application")

    'Wordファイルの格納パス定義
    wordPath = ThisWorkbook.Path
    'コピー元Wordファイル名定義
    sourceWordName = "template.docx"


    'Excelデータの取得
    mr = 3      '置き換え元文言記載行
    br = 4      'データ開始行番号
    bc = 8      'データ開始列番号
    'データ終了行番号
    er = Cells(Rows.Count, bc).End(xlUp).Row
    'データ終了列番号
    ec = Cells(br, Columns.Count).End(xlToLeft).Column
    '置き換えデータ格納配列定義
    ReDim targetData(er - br, ec - bc)

    n1 = 0
    '行数分繰り返し
    For k = br To er
        n2 = 0
        '項目数分繰り返し
        For l = bc To ec
            '項目格納
            targetData(n1, n2) = Cells(k, l).Text
            n2 = n2 + 1
        Next l
        n1 = n1 + 1
    Next k

    '置き換え元文言格納配列定義
    ReDim findData(ec - bc)

    n3 = 0
    '置き換え元文言分繰り返し
    For n = bc + 1 To ec
        '置き換え元文言格納
        findData(n3) = Cells(mr, n).Value
        n3 = n3 + 1
    Next n


    '置き換え対象ファイル分繰り返し
    For m = 0 To UBound(targetData, 1) - 1

        '新規Wordファイル名定義
        newWordName = targetData(m, 0)

        'Wordファイルをコピー
        FileCopy wordPath & "\" & sourceWordName, wordPath & "\" & newWordName

        '新規Wordファイルを開く
        Set wordObj = wordApp.Documents.Open(wordPath & "\" & newWordName)

        '置き換えデータ分繰り返し
        For o = 0 To UBound(targetData, 2) - 1

            'Excelデータを置き換え
            wordObj.Content.Find.Execute findtext:=findData(o), ReplaceWith:=targetData(m, o + 1), MatchCase:=True, Replace:=wdReplaceAll

        Next o

        'Wordファイルを保存
        wordObj.Save

        'Wordファイルを閉じる
        wordObj.Close

        'Wordオブジェクトの解放
        Set wordObj = Nothing

    Next m

    'Wordアプリケーションオブジェクトの無効化
    Set wordApp = Nothing

End Sub