VBA 別シートの同じ日付の欄に値を貼付け

日次で届く売り上げデータを集計した後、別シートの記入用フォーマットにコピーしたいのですが、「Sheet1」にあるデータを、「Sheet2」の対応する日付の欄に＜値を貼付け＞するVBAを教えていただけないでしょうか。

※画像の参照をお願いします。

例えば「Sheet1」にある6/6のデータ（B6:C25）を、マクロで「Sheet2」の6/6の欄に
＜値を貼付け＞したいです。
「Sheet1」には、1日分のデータ欄のみがあります。
「Sheet2」には、あらかじめ1年分の記入欄を用意しています。

集計をしない日もあるため、記入用フォーマット（Sheet2）の左端から詰めていくという方法は使えませんでした。
集計をしない日は空欄のままにしたいです。

それと欲を張ってすみませんが、以下の場合は動作を中止して、警告を出すようにしたいです。
・記入用フォーマットに、対応する日付が無かった場合
・記入用フォーマットの対応する日付の欄に、すでに何かが記入されている場合

説明が分かりづらかったらすみません。

よろしくお願いします。

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

• 補足します。
  
  ■Sheet1の日付欄は、画像の通りC4になりますが、Sheet2の日付欄は画像とは違います。
  例えば6/4（土）はED4、6/6（月）はEH4になります。
  ■コードは重複しません。ですが、実は「コード」と「売上」の代わりに「単価」と「個数」という表も存在していて、そちらにも応用できると嬉しいです。
  ■「コード」があって「売上」が空白、というパターンはないですが、ローデータの関係で「コード」があって「売上」が「0」になることはあります。

    補足日時：2016/06/06 19:27

• 補足2
  ■Sheet1の表の左上はB4、Sheet2の表の左上はF4になります。
  ちなみにSheet2のF4には、「4/1」と記入されています。

    補足日時：2016/06/06 19:42

• 補足3
  ■「単価」と「個数」のシートですが、タイトル部分も「単価」「個数」になります。
  また売上を計算したり、3列になることはありません。

    補足日時：2016/06/06 21:57

No.4 ベストアンサー 回答者： GooUserラック 回答日時： 2016/06/06 20:56

例外は無いとして以下の様なものでいかがでしょうか？

-------------------------------------------------------------
Sub 集計()

Dim 日付 As Date
Dim 列番号 As Long

日付 = Sheets("Sheet1").Cells(4, 3).Value
Sheets("Sheet2").Select
For 列番号 = 6 To Cells(4, Columns.Count).End(xlToLeft).Column Step 2
If Cells(4, 列番号).Value = 日付 Then Exit For
Next
If Cells(4, 列番号).Value <> 日付 Then
MsgBox ("対象の日付が見つかりませんでした。")
Exit Sub
End If
If Cells(Rows.Count, 列番号).End(xlUp).Row <> 5 Then
Cells(Cells(Rows.Count, 列番号).End(xlUp).Row, 列番号).Select
MsgBox ("データが既に書き込まれています。")
Exit Sub
End If
Sheets("Sheet1").Select
Range(Cells(6, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 3)).Copy
Sheets("Sheet2").Select
Cells(6, 列番号).Select
Selection.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False

End Sub
-------------------------------------------------------------

この回答へのお礼

こちらで上手くいきました。
別シートへの応用も問題なしでした。本当に助かりました。
またよろしくお願いします。

お礼日時：2016/06/08 18:03

No.7 回答者： tom04 回答日時： 2016/06/06 23:00

No.6です。

＞・記入用フォーマットに、対応する日付が無かった場合
＞・記入用フォーマットの対応する日付の欄に、すでに何かが記入されている場合

を見逃していました。
前回のコードは消去し↓のコードにしてみてください。
そして、画像のアップを忘れていましたので、
一緒にアップします。

Sub Sample2()
Dim c As Range, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
Set c = wS.Rows(4).Find(what:=Format(.Range("C4"), "m/d(aaa)"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
If wS.Cells(Rows.Count, c.Column).End(xlUp).Row = 4 Then
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
If lastRow > 5 Then
Range(.Cells(6, "B"), .Cells(lastRow, "C")).Copy
wS.Cells(Rows.Count, c.Column).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Else
MsgBox "入力済みです"
Exit Sub
End If
Else
MsgBox "該当する日付なし"
End If
End With
End Sub

※　今回はSheet1のデータには手を付けていません。
どうも失礼しました。m(_ _)m

この回答へのお礼

ありがとうございます。
各シートについては、画像の通りになっています。
これから試してみます。

お礼日時：2016/06/07 11:42

No.6 回答者： tom04 回答日時： 2016/06/06 22:44

こんばんは！

横からお邪魔します。
Sheetのレイアウトは↓のような感じになっているとします。
Sheet1のC4セル日付は必ずSheet2の4行目にあるという前提で・・・

Sub Sample1()
Dim myCol As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
myCol = WorksheetFunction.Match(.Range("C4"), wS.Rows(4), False)
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
If lastRow > 5 Then
Range(.Cells(6, "B"), .Cells(lastRow, "C")).Copy
wS.Cells(Rows.Count, myCol).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Range(.Cells(6, "B"), .Cells(lastRow, "C")).ClearContents '←Sheet1のデータを消去★//
End If
End With
End Sub

※　Sheet2へ「値」の貼り付けを行った後にSheet1のデータを消去するようにしています。

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

No.5 回答者： GooUserラック 回答日時： 2016/06/06 22:05

No.4 のコードはタイトル行の文字には影響されませんので、レイアウトが同じならばそのまま使えると思います。

この回答へのお礼

わかりました、早速試してみます。
取り急ぎ御礼申し上げます。
ありがとうございます！

お礼日時：2016/06/07 11:41

No.3 回答者： GooUserラック 回答日時： 2016/06/06 19:57

もう一つ質問です。

Sheet1 で「単価」と「個数」となっているとき Sheet2 のタイトルの部分も直すのですか？それとも「単価」×「個数」で計算して「売上」の欄に代入するのですか？その時は Sheet1 は「コード」「単価」「個数」の３列になったりしますか？また順番が変わったりしますか？

この回答へのお礼

遅くなりましたが、補足3を追記しました。
よろしくお願いします。

お礼日時：2016/06/06 21:58

No.2 回答者： GooUserラック 回答日時： 2016/06/06 19:35

すみません。

質問の仕方が悪かったようです。
① 実際の Sheet1 と Sheet2 の左上のセルはどこになりますか？

この回答へのお礼

意図が分からず失礼しました。
補足を追加したのでよろしくお願いします。

お礼日時：2016/06/06 19:43

No.1 回答者： GooUserラック 回答日時： 2016/06/06 19:06

① 実際の Sheet1 の「日付：」と Sheet2 の「6/4(土)」のセルは、それぞれ「B4」と「E4」で良いのですか？

② Sheet1 のコードは重複は無いとして扱ってよいのですか？
③ コードがあって売上がないとか、コードがなくて売上が無いとかは無いとしてよろしいですか？

この回答へのお礼

ご質問の件、補足に追記させていただきました。
よろしくお願いします！

お礼日時：2016/06/06 19:28