一致する値のみ抽出し表示する方法【エクセル2010】

別ファイルから一致する項目を探し、
一致していれば抜き出しをする方法が
わかる方いましたらよろしくお願いいたします。

ファイル① シート①
A B C
ab01 2000 りんご
ab09 1500 ぶどう

ファイル① シート②
A B C
ac07 1300 りんご
ac13 1600 みかん

ファイル① シート③
A B C
ad25 2000 みかん
ad12 1600 ぶどう

ファイル②
A B C
ab01 3600 ぶどう
ab02 2100 みかん
ac13 1200 りんご
ac15 1500 りんご
ad01 1000 みかん
ad09 1500 ぶどう

このようなデータがあって、
ファイル②のA列の値が、
ファイル①のA列同じ数字があれば
ファイル②の値を全て抜き出す。
この場合だと、
ab01 3600 ぶどう
ac13 1200 りんご

B列 C列は一致していません。
ファイル①は各シートごとに頭の文字が一緒です。


初めはファイル②のD列に関数使って
一致と表示してフィルタでやろうかと思いましたが、
それも私の技量ではできず…
別シートに抜き出せるとベストなのですが、
わかる方いましたらご教授ください。

質問者からの補足コメント

• 

  ご回答ありがとうございます。
  補足いたします。
  ⑴管理番号付属実績
  ⑵受注管理
  ⑶①仙台支店②福岡支店③名古屋支店
  ⑷なにも入っていません。二行目からデータが入っているだけです。
  ⑸シート1
  ⑹28年実績照会
  ⑺検証結果というファイルに、①はそのままエクセルで。②は検証結果-実績確認ファイルの中にはいっています。
  ⑻よろしくお願いいたします。
  
  以上、お手数ですがよろしくお願いいたします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2016/12/10 04:26

No.1 回答者： tatsu99 回答日時： 2016/12/09 23:17

いくつか質問があります。

１）ファイル①のファイル名は、何でしょうか。
２）ファイル②のファイル名は、何でしょうか。
３）ファイル①のシート①②③のシート名は何でしょうか。
４）ファイル①②とも見出しの有無はどうなっていますか。（1行目は見出しですか、データですか）
５）ファイル②のデータのあるシート名はなんですか。
６）別シートに抜き出すのは、ファイル②の別シートで良いですか。その場合、シート名はどうしますか。
７）二つのファイル①②は、同じフォルダ内にありますか。
８）マクロで実行しても良いですか。

No.2 回答者： 銀鱗 回答日時： 2016/12/10 02:21

丸ごとコピーし「リンク貼り付け」したものにフィルタを掛ければ良いような気がする。

No.3 回答者： ママチャリ 回答日時： 2016/12/10 12:02

「各シートの見出し行は空白」とのことですが、それなりの名称を設定しましょう（全シート同じ見出しにしてください）。

それが可能であれば、こんな感じで行けると思います。
ファイル②の標準モジュールに下記のマクロを張り付けて下さい。
ちなみに、下記コード中のBook1、Book2、および、SheetXは、alluvさんの環境に合わせて修正が必要です。

Sub Macro1()
Dim wbMoto As Workbook
Dim wsSaki As Worksheet
Set wbMoto = Workbooks("Book1")
Set wsSaki = Workbooks("Book2").Sheets("Sheet1")
wbMoto.Sheets("Sheet1").Copy After:=wsSaki.Parent.Sheets(wsSaki.Parent.Sheets.Count)
With ActiveSheet
wbMoto.Sheets("Sheet2").UsedRange.Copy _
Destination:=.Cells(Rows.Count, "A").End(xlUp).Offset(1)
wbMoto.Sheets("Sheet3").UsedRange.Copy _
Destination:=.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Range("A:C").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsSaki.Range("A1:A" & wsSaki.Range("A1").End(xlDown).Row), _
CopyToRange:=.Range("D1"), Unique:=False
.Columns("A:C").Delete Shift:=xlToLeft
End With
End Sub

No.4 回答者： tatsu99 回答日時： 2016/12/10 20:54

"受注管理"の標準モジュールに以下のマクロを登録してください。

登録後、保存する場合は、拡張子がxlsmになるので、ファイル名は"受注管理.xlsm"になります。
-----------------------------------------
Option Explicit
Public Const trgBook As String = "管理番号付属実績.xlsx"
Public Const mainBook As String = "受注管理.xlsm"
Public Sub 受注実績集計()
Dim mydic As Object
Dim sheets As Variant
Dim mainSheets As Variant
Dim i As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxRow1 As Long
Dim row1 As Long
Dim row2 As Long
Dim key As String
If IsOpenWorkBook(trgBook) = False Then
MsgBox (trgBook & "がオープンされていません。処理を中止します。")
Exit Sub
End If
Set mydic = CreateObject("Scripting.Dictionary")
sheets = Array("仙台支店", "福岡支店", "名古屋支店")
'管理番号付属実績を処理
Workbooks(trgBook).Activate
For i = 0 To UBound(sheets)
If ExistsWorkSheet(sheets(i)) = False Then
MsgBox (sheets(i) & "が存在しません。処理を中止します。")
Exit Sub
End If
Call chumon_shukei(sheets(i), mydic)
Next
'受注管理を処理
Workbooks(mainBook).Activate
mainSheets = Array("Sheet1", "28年実績照会")
'ワークシートの存在チェック
For i = 0 To UBound(mainSheets)
If ExistsWorkSheet(mainSheets(i)) = False Then
MsgBox (mainSheets(i) & "が存在しません。処理を中止します。")
Exit Sub
End If
Next
Set sh1 = Worksheets(mainSheets(0))
Set sh2 = Worksheets(mainSheets(1))
sh2.Cells.Clear '実績照会のクリア
maxRow1 = sh1.Cells(Rows.Count, 1).End(xlUp).row ' Sheet1の最終行を求める
row2 = 2
'Sheet1を2～最終行まで繰り返す
For row1 = 2 To maxRow1
key = sh1.Cells(row1, 1).Value
If mydic.exists(key) Then
sh1.Rows(row1).Copy (sh2.Rows(row2))
row2 = row2 + 1
End If
Next
MsgBox ("処理終了")
End Sub
'注文の集計
Private Sub chumon_shukei(ByVal sheetname As Variant, ByVal mydic As Object)
Dim sh As Worksheet
Dim maxrow As Long
Dim row As Long
Dim key As String
Set sh = Worksheets(sheetname)
maxrow = sh.Cells(Rows.Count, 1).End(xlUp).row ' 最終行を求める
For row = 2 To maxrow
key = sh.Cells(row, 1).Value
mydic(key) = True
Next
End Sub
'ワークブックのオープンチェック
Private Function IsOpenWorkBook(ByVal bookName As String) As Boolean
IsOpenWorkBook = False
Dim wk As Workbook
For Each wk In Workbooks
If wk.Name = bookName Then
IsOpenWorkBook = True
Exit Function
End If
Next
End Function

'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal sheetname As String) As Boolean
Dim ws As Worksheet
ExistsWorkSheet = False
For Each ws In Worksheets
If ws.Name = sheetname Then
ExistsWorkSheet = True
Exit Function
End If
Next ws
End Function
----------------------------------------------
マクロ実行時は、"管理番号付属実績.xlsx"（管理番号付属実績.xlsmではありません）をオープンした状態で、
マクロ「受注実績集計」を実行してください。
以下の前提で作成しています。
ファイル①：管理番号付属実績.xlsx
シート①：仙台支店
シート②：福岡支店
シート③：名古屋支店
ファイル②：受注管理.xlsm
シート①：Sheet1　・・・・データのあるシート名
シート②：28年実績照会　・・・・空のシート（ここへ作成）

上記のファイル、シートがない場合はエラーになります。（28年実績照会も空のシートを作っておいてください）