【VBA】VLOOKUP関数で別シートに同じ値を貼り付けたい

Question

前提

VBAで任意の日付に異動した社員リストを出力するマクロを作っています。
使用するブックは1つで、シートは以下の2枚です。

1. 社員マスタ
2. 異動者リスト

『異動者リスト』A列に、ある日に異動した社員の『社員番号』を記入しています。
※『社員マスタ』『異動者リスト』の表はA列～EN列まであり、2行目の項目名は全て同じで、各セルは同じ列幅、同じフォントの大きさに調整しています。

【社員マスタ】

【異動者リスト】

実現したいこと

『社員マスタ』と『異動者リスト』A列を比較して社員番号が一致した場合のみ、『社員マスタ』のＡ列～EN列をコピーして『異動者リスト』に貼り付けて、最終行までこれを繰り返すコードにしたいです。
『社員番号を検索し出力するマクロ』はすでに作成しているので、ここではA列より右の値をコピー＆ペーストするだけのマクロを作成します。

試したこと

下記2つのURLから、サンプルコードを組み合わせて作成しました。

該当のソースコード

Sub 別のシートからVLookup()
  Dim tbl As Range
  Set tbl = Sheets("社員マスタ").Range("A3:B2191")
  Dim key As Long
  key = Range("A3").Value

  On Error Resume Next
  Dim ret As String
  ret = WorksheetFunction.VLookup(key, tbl, 2, False)

    '最終行を取得する
  Dim LastRow As Long
  LastRow = Worksheets("異動者リスト").Cells(Rows.Count, "A").End(xlUp).Row

  'ループする
  For i = 3 To LastRow
    With Cells(i, "B")
    
  'VLookup関数を計算する
    .Offset(0, 1) = ret
    End With
  Next

End Sub

発生している問題・エラーメッセージ

異動者リストのB列に氏名を入れたいのですが、上述のコードを実行すると、下の画像のように『異動者リスト』のC列にA3の社員番号に対応する社員の氏名が最終行まで連続して出力されてしまいました。
オフセットの数字の設定に問題があるとは思いますが、その解釈で合っているでしょうか。
また、この場合1列分しか出力できていないので、検索する右の範囲をEN列まで広げて、全てのセル値を貼り付けたいです。

VLOOKUP関数にこだわらず範囲指定でコピー＆ペーストする方法があれば、ご教示いただければ幸いです。よろしくお願いいたします。

補足情報（FW/ツールのバージョンなど）

PC：Windows11
ソフト：Microsoft365 Excel
参考URL:

• VBAで別シートからVLookup
• 【VBA】VLookupを最終行まで繰り返し使う【Endを使います】

Comments

[hatena19]

社員マスタと異動者リストの2行目の項目名は同じですか。

[koburon]

はい、2行目のA列からEN列まで全て名前は同じです。

Answer 1

vlookupは使用していませんが、以下でどうでしょうか。

Sub 別のシートからVLookup()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim row1 As Long
    Dim row2 As Long
    Set ws1 = Worksheets("社員マスタ")
    Set ws2 = Worksheets("異動者リスト")
    
    '最終行を取得する
    lastRow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row

    'ループする
    For row2 = 3 To lastRow2
        For row1 = 3 To lastRow1
            If ws2.Cells(row2, 1).Value = ws1.Cells(row1, 1).Value Then
                ws2.Cells(row2, 2).Resize(, 143).Value = ws1.Cells(row1, 2).Resize(, 143).Value
                Exit For
            End If
        Next
    Next

End Sub

Comments

[koburon]

回答ありがとうございます。
ループを2回行わせる方法がよく理解できていなかったので助かりました。
ありがとうございました。