エクセルのデータ検索＆抽出作成について

質問

Excelの別シートでの検索と抽出について

ExcelファイルでSheet1～５まで部署別の発注データで項目は下記の通りA列～G列まですべて同じになっているものがあります。
A列 B列 C列 D列 E列 F列 G列
注文番号 商品名 納品日 納品先 発注額 消費税 合計額

別シート（Sheet6）に「商品名」や「納品先」で検索する項目を作成し、その結果を表示できるようにしたいのですが何か良い方法はないでしょうか？
マクロ・VBAでの作成方法もあればお願いします。

Excelのバージョンは2010です。
並べ替えとフィルター → 詳細設定 → フィルタオプションの設定 で試してみましたが、検索する商品名（納品場所）を変更してしまうと抽出されませんでした。

宜しくお願いします。

回答No.1

tom04 · ベストアンサー

こんにちは！
VBAでの一例です。

Sheet6は画像通りに配置になっていて、
Sheet1～Sheet5は1行目が項目行で2行目以降にデータがあるとします。

Alt＋F11　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim k As Long, endRow As Long, wS6 As Worksheet
Set wS6 = Worksheets("Sheet6") '←Sheet6は実際のSheet名に！
endRow = wS6.Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 9 Then
Range(wS6.Cells(10, "A"), wS6.Cells(endRow, "G")).ClearContents
End If
For k = 1 To 5
With Worksheets(k)
.Range("A1").AutoFilter field:=2, Criteria1:=wS6.Range("B2")
.Range("A1").AutoFilter field:=4, Criteria1:=wS6.Range("B4")
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 1 Then
Range(.Cells(2, "A"), .Cells(endRow, "G")).SpecialCells(xlCellTypeVisible).Copy wS6.Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
End With
Worksheets(k).AutoFilterMode = False
Next k
End Sub 'この行まで

こんな感じではどうでしょうか？m（_ _）m

お礼

ありがとうございました！大変助かりました。