VBA、条件に合致・貼り付けについて

始めて投稿させて頂きます。
VBA勉強中であり、既出でありましたら、大変失礼致します。

エクセルで、sheet1 セル：C2には、日付が
　　　　　　　　　　　　 C3には、売上数が
　　　　　　　　　　　　 C4には、売上金額が入っています。

それぞれは、日々更新していきます。

Sheet2のセル：B2:AE2に、2017/2/1～2017/3/2の日付が入力されており　※①、②
※①（今月の場合）
※②（1カ月+3日分）

B3:AE3に、それぞれの日の売上数
B4:AE4に、それぞれの日の売上金額
を入力する場所を設けてあります。

Sheet1の日々変わるセルC3:C4をVBAにて、sheet2の該当する欄に値の貼り付けを出来るようにしたいです。

該当する日付を調べるまでは、なんとか出来ましたが、そこから先がうまくいきません。

恐縮ですが、知恵のあります方、ご教授をお願い致します。

No.1 回答者： tatsu99 回答日時： 2017/02/22 23:00

以下のマクロを標準モジュールに登録してください。

----------------------------------------------
Option Explicit
Public Sub 売上設定()
Const sh1 As String = "Sheet1"
Const sh2 As String = "Sheet2"
Dim dif As Long
dif = Worksheets(sh1).Cells(2, "C").Value - Worksheets(sh2).Cells(2, "B").Value
If dif < 0 Or dif > 99 Then
MsgBox ("該当日付なし")
Exit Sub
End If
If Worksheets(sh2).Cells(2, 2 + dif).Value <> Worksheets(sh1).Cells(2, "C").Value Then
MsgBox ("該当日付なし")
Exit Sub
End If
'該当日付に数量、金額を設定
Worksheets(sh2).Cells(3, 2 + dif).Value = Worksheets(sh1).Cells(3, "C").Value '数量
Worksheets(sh2).Cells(4, 2 + dif).Value = Worksheets(sh1).Cells(4, "C").Value '金額
MsgBox ("設定完了")
End Sub
------------------------------------------------------

この回答へのお礼

回答ありがとうございます。

早速試させて頂きましたが、良さそうです。
勉強不足な感、痛感致しました。
引き続き勉強していきたいと思います。

お礼日時：2017/02/23 10:33

No.2 回答者： tom04 回答日時： 2017/03/01 21:41

こんばんは！

すでに回答は出ていますので、参考程度で・・・
標準モジュールです。

Sub Sample1()
Dim c As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
If WorksheetFunction.CountBlank(.Range("C2:C4")) = 0 Then
Set c = wS.Rows(2).Find(what:=DateValue(.Range("C2")), LookIn:=xlFormulas, lookat:=xlWhole)
If Not c Is Nothing Then
c.Offset(1) = .Range("C3")
c.Offset(2) = .Range("C4")
Else
MsgBox "該当日付なし"
.Activate
.Range("C2").Select
End If
Else
.Activate
.Range("C2:C4").SpecialCells(xlCellTypeBlanks).Select
MsgBox "データを入力してください"
End If
End With
End Sub

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