ある表値を別の表の列と行の条件に合うセルにコピーするマクロを教えてください。

VBAで教えて頂きたいことがあります。
【リスト1】のような表を毎日入手します。
それを【リスト2】のような、列に日にち、行に食品の種類が書かれた表の「消費」の行に数字をコピーしたいのですが、どのようなマクロを書けばいいですか。
A列：食品の種類。B列：購入or消費。C列以降：日にち。です。



【リスト1】
消費日 4/3
----------------
みかん 10　　　 ⇒セルE3にコピー
とまと 4　　　 ⇒セルE9にコピー
なす　　 6 　　 ⇒セルE11にコピー


【リスト2】

　　　　A列　Ｂ列　　　 C 列 　D列 E列 F列 　 G列 ～ 　AF列
1行　　　 　　　 4/1 　　4/2 4/3 　 4/4 　 4/5 ～ 4/30
　　---------------------------------------------------------------------
2行　　みかん 購入
3行　　 　　　 消費
　　---------------------------------------------------------------------
4行　　りんご 購入
5行　　 　　 消費
　　---------------------------------------------------------------------
6行　　ぶどう 購入
7行 　　　 　 消費
　　---------------------------------------------------------------------
8行　　とまと 購入
9行 　 　　 　 消費
　　---------------------------------------------------------------------
10行　　なす 購入
11行　　 　　 消費
　　---------------------------------------------------------------------

どうぞよろしくお願いいたします。

No.2 ベストアンサー 回答者： tom04 回答日時： 2016/04/15 16:22

こんにちは！

一例です。
元データは↓の画像のような配置でSheet1にあるとし、Sheet2に表示させるとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, c As Range, r As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
Set c = wS.Rows(1).Find(what:=.Range("B1").Text, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
Set r = wS.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
wS.Cells(r.Row + 1, c.Column) = .Cells(i, "B")
End If
Next i
End If
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございます。
まさにやりたかっとことができました。
ありがとうございました！

お礼日時：2016/04/16 15:41

No.1 回答者： 飛行機がすきです 回答日時： 2016/04/15 09:26

VBAを使わなくてもSUMIFS関数使えばできるような気がします。

マクロ走らせなくても、自動更新されるし便利かもしれません。