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

Question

日次で届く売り上げデータを集計した後、別シートの記入用フォーマットにコピーしたいのですが、「Sheet1」にあるデータを、「Sheet2」の対応する日付の欄に＜値を貼付け＞するVBAを教えていただけないでしょうか。

※画像の参照をお願いします。

例えば「Sheet1」にある6/6のデータ（B6:C25）を、マクロで「Sheet2」の6/6の欄に
＜値を貼付け＞したいです。
「Sheet1」には、1日分のデータ欄のみがあります。
「Sheet2」には、あらかじめ1年分の記入欄を用意しています。

集計をしない日もあるため、記入用フォーマット（Sheet2）の左端から詰めていくという方法は使えませんでした。
集計をしない日は空欄のままにしたいです。

それと欲を張ってすみませんが、以下の場合は動作を中止して、警告を出すようにしたいです。
・記入用フォーマットに、対応する日付が無かった場合
・記入用フォーマットの対応する日付の欄に、すでに何かが記入されている場合

説明が分かりづらかったらすみません。

よろしくお願いします。

GooUserラック · Accepted Answer

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

-------------------------------------------------------------
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
-------------------------------------------------------------

tom04 · Answer

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

tom04 · Answer

こんばんは！

横からお邪魔します。
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

GooUserラック · Answer

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

GooUserラック · Answer

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

GooUserラック · Answer

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

GooUserラック · Answer

① 実際の Sheet1 の「日付：」と Sheet2 の「6/4(土)」のセルは、それぞれ「B4」と「E4」で良いのですか？
② Sheet1 のコードは重複は無いとして扱ってよいのですか？
③ コードがあって売上がないとか、コードがなくて売上が無いとかは無いとしてよろしいですか？

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

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

No.6です。

こんばんは！

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

もう一つ質問です。

すみません。

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

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

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