VBA 値と一致した行の一部の列のデータを転記について教えてください

ＶＢＡ勉強中で調べながらプログラムを作成しています。
調べた中で似た内容のプログラムを実行させたのですが自分が実行したい内容と
一部違うのでどうすればいいのかをご教授いただけると助かります。

下記プログラムではコメントでもあるように１行全部の転記となってしまう為
一部の列のみを転記するプログラムに変更したいです。

◆似た内容のプログラム◆

Sub Sample()

Dim c As Range
Dim v() As Variant
Dim cols As Long
Dim j As Long
Dim dic As Object

Set dic = CreateObject("Scripting.Dictionary")

With Sheets("Sheet2")
'シート２のA3からA列のデータ最終行までのセルを１つずつ取り出す
For Each c In .Range("A3", .Range("A" & .Rows.Count).End(xlUp))
dic(c.Value) = dic.Count + 1 'その値をキー、１からの連番をデータとして辞書登録
Next
End With

With Sheets("Sheet1")
'シート１の列数取得
cols = .UsedRange.Cells(.UsedRange.Cells.Count).Column
ReDim v(1 To dic.Count, 2 To cols) '転記用配列
'シート1のG5からG列のデータ最終行までのセルを１つずつ取り出す
For Each c In .Range("G5", .Range("G" & .Rows.Count).End(xlUp))
'もし辞書にあれば（シート２にあれば）１行分のイメージを配列に格納
If dic.exists(c.Value) Then
For j = 2 To cols
v(dic(c.Value), j) = c.EntireRow.Cells(j).Value
Next
End If
Next
End With

With Sheets("Sheet2")
.Range("I3").Resize(UBound(v, 1), UBound(v, 2)).Value = v
.Select

End With

MsgBox "転記終了"

End Sub

◆実行したい内容◆
【Sheet2】Ａ3～最終行までの番号（値）をキーとして
【Sheet1】Ｇ5～最終行までの番号（値）と一致した同じ行の一部の列(B5・K5・M5・S5の最終行まで)を
【Sheet2】一致した番号（値）と同じ行の列（I3・J3・K3・L3の最終行まで）に転記したいと思っています。
　　　　　
　　転記元　　 ⇒　　　転記先
【Sheet1】B列　⇒　【Sheet2】I列
【Sheet1】K列　⇒　【Sheet2】J列
【Sheet1】M列　⇒　【Sheet2】K列
【Sheet1】S列　⇒　【Sheet2】L列

宜しくお願い致します。

No.1 ベストアンサー 回答者： tom04 回答日時： 2016/08/23 16:37

こんにちは！

人様がお考えになったコードに手を加えるのは好みではないので・・・

Sub Sample1()
Dim i As Long, c As Range, wS As Worksheet
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS.Range("G:G").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
With .Cells(i, "I")
.Value = wS.Cells(c.Row, "B")
.Offset(, 1) = wS.Cells(c.Row, "K")
.Offset(, 2) = wS.Cells(c.Row, "M")
.Offset(, 3) = wS.Cells(c.Row, "S")
End With
End If
Next i
End With
MsgBox "完了"
End Sub

※　Sheet1のG列に重複データがある場合、
最初にヒットした行のデータが表示されます。

こんな感じをご希望をご希望なのでしょうか？m(_ _)m

この回答へのお礼

新たなプログラムを教えていただきありがとうございました。
希望してた処理ができました！！

お礼日時：2016/08/23 20:09