EXCEL VBA で教えてください。（別シートから該当する値の場合、1行コピー）

こんばんは。EXCEL VBAで教えてください。
シート１、シート２があります。シート１にはデータが入っています。シート２に名簿が入っています。
シート２のB列に社員番号があります。
シート１のC列にシート２のB列の社員番号が該当する場合、シート3にシート１の該当行データ（1行）をコピーしていきたいのです。
arrayやフィルタオプション、select case等どのように使えばいいかわかりません。
ご教示よろしくお願い致します。

No.2 ベストアンサー 回答者： tatsu99 回答日時： 2017/10/12 09:57

No1です。

以下のマクロを標準モジュールへ登録してください。
----------------------------------------
Public Sub データコピー()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim dicT As Object
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim okctr As Long
Dim ngctr As Long
Dim row As Long
Dim row3 As Long
Dim key As String
Set sh1 = Worksheets("data")
Set sh2 = Worksheets("名簿")
Set sh3 = Worksheets("結果")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow1 = sh1.Cells(Rows.Count, "C").End(xlUp).row
maxrow2 = sh2.Cells(Rows.Count, "B").End(xlUp).row
Application.ScreenUpdating = False

For row = 2 To maxrow2
key = sh2.Cells(row, "B").Value
dicT(key) = sh2.Cells(row, "C").Value
Next
okctr = 0
ngctr = 0
row3 = 2
sh3.Cells.Clear
sh1.Rows(1).Copy sh3.Rows(1)
For row = 2 To maxrow1
key = sh1.Cells(row, "C").Value
If dicT.exists(key) = True Then
sh1.Rows(row).Copy sh3.Rows(row3)
okctr = okctr + 1
row3 = row3 + 1
Else
ngctr = ngctr + 1
End If
Next
Application.ScreenUpdating = True
MsgBox ("処理件数=" & okctr & " 未処理件数=" & ngctr)

End Sub
------------------------------------------

この回答へのお礼

tatsu99さん、こちらのコードもありがとうございました。無事作成できました。ありがとうございました。

お礼日時：2017/10/12 21:04

No.1 回答者： tatsu99 回答日時： 2017/10/12 00:16

１）シート１、シート２、シート３の具体的なシート名はどうなってますか。

２）シート１、シート２、シート３の1行目は見出し行ですか。
３）提示された情報でわかるのは、添付の図の情報だけです。
添付の図のように具体的なセル位置の情報を提示していただけませんでしょうか。

この回答へのお礼

tatsu99さん、返信ありがとうございます。
（１）シート名１は"data",シート名2は"名簿",シート名3は"結果"です。（２）1行目はすべて見出し行にしたいです。
（３）シート1"data"はA列からM列まであり、行は2万行ぐらいあります。
　　　シート2"名簿"はB列社員番号、C列氏名、D列所属で300行ぐらいあり
　　　ます。

ご教示よろしくお願い致します。

お礼日時：2017/10/12 06:58