エクセル マクロ

質問

以下の処理を教えて頂ける方がいらっしゃいましたらご教示ください。

A - B - C - D - E
日付 - 商品名 - 単価 - 数量 - 金額
a41 - バナナ - 120 - 10 - 1,200
a42 - みかん - 110 - 20 - 2,200
a42 - りんご - 150 - 10 - 1,500
a42 - バナナ - 120 - 15 - 1,800
a42 - なし - 150 - 20 - 3,000
a51 - りんご - 150 - 30 - 4,500
a51 - バナナ - 120 - 25 - 3,000
a51 - なし - 160 - 20 - 3,200
a52 - りんご - 145 - 35 - 5,075
a52 - みかん - 120 - 40 - 4,800
a53 - バナナ - 115 - 25 - 2,875
上記、シート１のデータが、3０００行あります。

A - B - C - D - E
日付
a42
a52
上記、シート2のデータが、15０行あります。

A - B - C - D - E
日付 - 商品名 - 単価 - 数量 - 金額
a42 - みかん - 110 - 20 - 2,200
a42 - りんご - 150 - 10 - 1,500
a42 - バナナ - 120 - 15 - 1,800
a42 - なし - 150 - 20 - 3,000
a52 - りんご - 145 - 35 - 5,075
a52 - みかん - 120 - 40 - 4,800
シート3に上記データのように抽出するには、どうすればよろしいでしょうか。

オートフィルタで,抽出後、抽出範囲をシート３にコピー貼り付けを繰り返しているのですが、もっといい方法（VBA）で、できませんでしょうか。

回答No.1

tom04 · ベストアンサー

こんばんは！
各Sheetとも1行目はタイトル行で、データは2行目以降にある（表示する）とします。

一例です。
Alt＋F11キー　→　画面左側の「This Workbook」をダブルクリック　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test()
Dim i As Long, k As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
k = ws3.Cells(Rows.Count, 1).End(xlUp).Row
If k > 1 Then
Range(ws3.Cells(2, 1), ws3.Cells(k, 5)).ClearContents
End If
For k = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
ws1.Columns("A:D").AutoFilter field:=1, Criteria1:=ws2.Cells(k, 1)
i = ws1.Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
Range(ws1.Cells(2, 1), ws1.Cells(i, 5)).Copy Destination:= _
ws3.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next k
ws1.Select
Selection.AutoFilter
End Sub

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

お礼

素早い回答ありがとうございます。
出来ました。
しかも、わかりやすい回答で、素晴らしいです。
本当に感謝します。