Sub createTestCard() ' Excelのテストデータがあるシートを開く Dim excelApp As Excel.Application Set excelApp = CreateObject("Excel.Application") Dim book As Excel.Workbook Dim dataSheet As Excel.Worksheet Set book = excelApp.Workbooks.Open(ThisDocument.Path & "\サンプルデータ.xlsx") Set dataSheet = book.Worksheets("データ") currentRow = 4 ' Wordのカーソルを先頭に戻す ActiveDocument.Range(0, 0).Select ' メインループ(データをあるだけ取る) Do Until IsEmpty(dataSheet.Cells(currentRow, 2)) For currentCol = 2 To 6 ' 1行ずつ取ってはデータに入れる With Selection.Find .Text = "$" + Format(currentCol - 1, "00") .Execute Selection.Range.Text = dataSheet.Cells(currentRow, currentCol).Value End With Next ' 次の行に進む currentRow = currentRow + 1 Loop ' 終了処理 book.Close Set excelApp = Nothing End Sub