다른 시트의 정보를 참조하여 값 세트

Sub vlookupItemValues()
    Dim SHEET1 As Worksheet             ' 駆動表シート
        Set SHEET1 = Worksheets("Sheet1")

    Dim SHEET2 As Worksheet             ' 突合先シート
        Set SHEET2 = Worksheets("Sheet2")

    Dim SHEET1_GYO As Long          ' 処理対象の開始行
    Dim SHEET2_GYO As Long

    Dim SHEET1_GYO_CNT As Long          ' 件数計上
        SHEET1_GYO_CNT = 0      ' 処理件数

    Dim SHEET1_ITEMS_COL_START As Long  ' 編集先のセルの列番号 (変動値)

    Dim SHEET1_KEY1 As String
    Dim SHEET2_KEY1 As String
    Dim SHEET2_ITEM2 As String
    Dim SHEET2_ITEM3 As String

    '駆動表のルール
    SHEET1_GYO = 3  'sheet1の対処データ範囲（3行目から～空白のセルの行まで）
    Do Until SHEET1.Cells(SHEET1_GYO, 1).Value = ""

        SHEET1_KEY1 = SHEET1.Cells(SHEET1_GYO, 1).Value
        SHEET1_ITEMS_COL_START = 9

        SHEET2_GYO = 2  'sheet2のVlookup範囲（2行目から～空白のセルの行まで）
        '突合先シート
        Do Until SHEET2.Cells(SHEET2_GYO, 1).Value = ""
            SHEET2_KEY1 = SHEET2.Cells(SHEET2_GYO, 1).Value
            SHEET2_ITEM2 = SHEET2.Cells(SHEET2_GYO, 2).Value
            SHEET2_ITEM3 = SHEET2.Cells(SHEET2_GYO, 3).Value

            If SHEET1_KEY1 = SHEET2_KEY1 Then   '突合のKEY
              SHEET1.Cells(SHEET1_GYO, SHEET1_ITEMS_COL_START).Value = SHEET2_ITEM2
              SHEET1_ITEMS_COL_START = SHEET1_ITEMS_COL_START + 1
              SHEET1.Cells(SHEET1_GYO, SHEET1_ITEMS_COL_START).Value = SHEET2_ITEM3
              SHEET1_ITEMS_COL_START = SHEET1_ITEMS_COL_START + 1
            End If
            SHEET2_GYO = SHEET2_GYO + 1
         Loop

         SHEET1_GYO_CNT = SHEET1_GYO_CNT + 1
         SHEET1_GYO = SHEET1_GYO + 1
    Loop

    ' 終了の表示
    MsgBox "完了しました。" & vbCr & _
        "レコード件数=" & SHEET1_GYO_CNT & "件"
End Sub