VBAで複数のエクセルシートから必要なデータを転記したい

以前、VLOOKUPの質問をさせていただいたのですが理解することができず
VBAでなら複雑な条件の検索と転記ができるのではないかと思い、教えてください

やりたいことは、
生産計画シートが二つあるのですが、そこから日付をもとに検索し
生産する品種のデータを転記したいのです。
vLOOKUPでやると日付のセルが結合されているため、転記が1行分しかできず不可能でした。
転記したいセルが５個 縦にならんでいるので日付がHITしたらこの範囲をココに転記できる
というVBAはできないでしょうか？

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

• ちょっと見づらいかもしれませんが貼り付けてみました
  画像のようなレイアウトの中から一致する日付の生産品種　コードを5行分抽出したいのです

  
    補足日時：2017/02/20 22:41

• 検索の対象は同一ファイルのシートにあるのではなく、2つのエクセルファイル（同じレイアウト）の中から一致する日付のデータのみを抽出してくるというイメージです

    補足日時：2017/02/20 22:43

No.4 回答者： yokomaya 回答日時： 2017/02/23 11:14

恐らく１ページに印刷するためにこのようなフォーマットの

表にしたのでしょうが、このフォーマットはあくまでも
印刷用でEXCELのデータはあくまでも２次元の表で
作って、印刷用にこの形式に表の任意の部分が表示できる
事を実現するほうが例えVBAを使う使わないに関わらず
合理的です。
例えば別シートのA列に日付をB列以降にこのケースだと
コード、生産品種が10列続くかな。
そこにデータを並べていくんです。
そうすれば30年分貯めても１万行強しか使いません。

そしてこの表の上でVLOOKUPが使えます。
VLOOKUPよりも
５月6日の所だけ入力すれば別シートのA列の何行目に
見つかるかをどっかに覚えてあとはINDEXでそれぞれの
セル位置に引き当てる数式を考えまるほうがいいかな？

あとの拡張、応用を考える時に２次元データで扱う習慣を
着ける事は、必ずEXCEL使い手への早道です。

No.3 回答者： WindFaller 回答日時： 2017/02/21 11:19

すでに、回答がついているようですが、ご質問に興味を持ちました。

最初に、こういうレイアウトで日付などをまとめてしまうことを、正規化というのですが、Excelでは、真っ正直に一緒にしてしまうので、取り扱いが簡単ではなくなってしまいます。無骨でも、本来は、表は表のままにしたほうがデータとしての取り扱いは、容易にさせるものだと思います。

ただ、よくみるとレイアウトは、カード型のデータベースそのものだと思います。Excelでカード型のデータベース・アプリもあったと思います。何かキリの良い時に、探してみるのもよいかもしれません。本格的なカード型のデータベースでもよいかと思います。Excelとは違って1週間程度で使いこなせられるようになります。

-------------
以下のマクロの検索は、日付検索でも、Formulas（数式内部) で検索しますので、年数が隠れています。検索される側も、文字ですとヒットはしません。シリアル値になっていなければなりません。したがって、入力をすれば、年は今年のものになります。年数がもし違うようでしたら、2016/2/21 としても検索します。

出力自体は、ベタな状態になっていますから、生産品種を、A列にコピーするだけのものです。（値コピーにしてあります)


'//標準モジュール
Sub FindMergedCell()
　Dim s_date As Variant
　Dim c As Range
　Dim Rng As Range
　Dim j As Long
　Dim dataSh1 As Worksheet
　Dim dataSh2 As Worksheet
　Dim TrSh As Worksheet
　Dim ws
　'ユーザー設定
　'*************************
　'検索用のシート
　On Error Resume Next
　With Workbooks("BookA.xlsm")
　　Set dataSh1 = .Worksheets("Sheet1")
　End With
　With Workbooks("BookB.xlsm")
　　Set dataSh2 = .Worksheets("Sheet1")
　End With
　If Err.Number <> 0 Then
　　If dataSh1 Is Nothing And dataSh2 Is Nothing Then
　　　MsgBox "2つのデータ両方ともありません。", vbExclamation
　　　Exit Sub
　　End If
　　If MsgBox("2つのブックが開いていないようですが、続行しますか？", vbOKCancel) = vbCancel Then
　　　Exit Sub
　　End If
　End If
　On Error Resume Next
　'転送先シート（検索用)
　Set TrSh = ThisWorkbook.Worksheets("Sheet1")　'*************************
　
　s_date = Application.InputBox("日付をいれてください。例 m/d ", "入力")
　If IsDate(s_date) = False Then MsgBox "日付と認識出来ませんでした。", vbExclamation: Exit Sub
　s_date = DateValue(s_date)
　For Each ws In Array(dataSh1, dataSh2)
　　If Not ws Is Nothing Then
　　　With ws
　　　　Set c = .UsedRange.Find( _
　　　　What:=s_date, _
　　　　After:=.Range("A1"), _
　　　　LookIn:=xlFormulas)
　　　　If Not c Is Nothing Then
　　　　　j = c.MergeArea.Rows.Count
　　　　　Set Rng = c.Offset(, 2).Resize(j)
　　　　　With TrSh
　　　　　　'A列に貼り付ける
　　　　　　'そのまま貼り付ける場合書式も一緒に貼り付けられる
　　　　　　'Rng.Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1)
　　　　　　'値コピー
　　　　　　.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(j, 1).Value = Rng.Value
　　　　　End With
　　　　End If
　　　End With
　　End If
　Next ws
　If Rng Is Nothing Then MsgBox "見つかりませんでした。", vbExclamation
　Set Rng = Nothing
　Set dataSh1 = Nothing
　Set dataSh2 = Nothing
　Set TrSh = Nothing
End Sub

No.2 回答者： tatsu99 回答日時： 2017/02/20 23:12

補足ありがとうございました。

まだ、レイアウトが完全に把握できませんので追加で質問させてください。
１）抽出元のブック名はなんですか。
２）抽出元のブック内のシート名はなんですか。
３）抽出元のシートのデータは6日分だけなのですか。
４）抽出元のシートの左側の日付はB列ですか。右側の日付はG列ですか。
５）抽出元のシートの1番上の日付の見出しは１行目ですか。（日付データは、２～６行の共有セル）
６）抽出先のブック内の抽出先のシート名はなんですか。
７）抽出先のブックにマクロがある前提です。抽出元のブックを開いている状態でマクロを実行する前提で良いですか。
（抽出元のブックのオープンはマクロでは行わない）

No.1 回答者： tatsu99 回答日時： 2017/02/20 19:59

前回の質問が不明なので、あなたが書かれていることが理解できません。

２つの生産計画シートのシート名は何でしょうか。
また、それらのレイアウトはどうなっていますか。
２つのシートについてレイアウトがわかるものを提示していただけませんでしょうか。
（添付の図のような例をお願いします）