エクセルで日々のデータを一ヶ月の集計表に蓄積

質問

初めての投稿です。VBA超初心者です。
シート11のA2セルにシート1からDATE関数で取得した日付があり、右のE2～X2セルにシート３～10で取得、まとめたデータがあります。このデータを一ヶ月の日付（シート１から取得したDATE関数で取得）A14～A44から探しその行のE～X列に転記したい
また、ファイル保存時に起動するようにと考えてますが行き詰っています。どうかお助け下さい。
よろしくお願いいたします。

回答No.2

HohoPapa · ベストアンサー

添付画像のように
上半分のコードをThisWorkbookをモジュールに
下半分のコードを標準モジュールに配置してみてください。

次行以下が上半分

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
　MyTenki
End Sub

次行以下が下半分です。

Option Explicit

Sub MyTenki()

　Const KRow = 2　 '転記日付の行位置
　Const KCol = 1　 '転記日付の列位置
　Const TRow = 14　'転記先範囲開始行
　Const TCol = 1　'転記先日付列番号
　Const SCol = 4　'転記範囲開始列
　Const ECol = 24　'転記範囲終了列

　Dim i As Long
　Dim HitRow As Long

　With ThisWorkbook.Sheets("自動車棚卸し集計")

　　'転記先の行番号を取得
　　i = TRow
　　HitRow = 0
　　Do
　　　If .Cells(i, TCol).Value = "" Then Exit Do
　　　If .Cells(i, TCol).Value = .Cells(KRow, KCol).Value Then
　　　　HitRow = i
　　　　MsgBox "Hit" & HitRow
　　　　Exit Do
　　　End If
　　　i = i + 1
　　Loop

　　'転記先行に複写
　　If HitRow <> 0 Then
　　　Range(.Cells(HitRow, SCol), .Cells(HitRow, ECol)).Value = _
　　　　Range(.Cells(KRow, SCol), .Cells(KRow, ECol)).Value
　　Else
　　　MsgBox "転記先が見つかりません"
　　End If

　End With

End Sub

お礼

回答いただきありがとうございました。 無知な私でもなんとか思い通りの動作をさせることができました。 ちなみに実行後にメッセージBOXに”HIT〇〇”と表示されますが不要な場合はどの部分を修正したらいいのでしょうか？

Powered by GRATICA

回答No.1

SI299792

シート位置は変わることがあるので、シート名で指定した方が安全です。
ThisWorkbookをダブルクリック、そこに入れて下さい。
'
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'
　　With Sheets("自動車棚卸し集計")
　　'
　　　　If Month(.[A2]) <> Month(.[A14]) Then
　　　　　　Cancel = MsgBox("月が違います、保存しますか", 17) = vbCancel
　　　　Else
　　　　　　.[E14:X14].Offset(.[A2] - .[A14]) = .[E2:X2].Value
　　　　End If
　　End With
End Sub

お礼

SI299792さんありがとうございました。 おかげさまで何とか思い通りの動作をさせることができました。

Powered by GRATICA

補足

SI299792さん早速の回答ありがとうございます。
早速コピペして実行してみました。ただ再立ち上げしてみたのですが何の変化もありません。何か違うのだと思いますが原因がわかりません。一つ考えられるのはすでに保存用のマクロが標準モジュールを実行することで実行されるようにしてます。競合しあって不具合が生じているのでしょうか？