Excel VBAでの数値転記の自動化

質問

現在、手作業で数値を貼り付けている作業をマクロで自動化したいです。

ファイルは２つで、参照元となるファイル“α”と、数値を貼り付けるファイル“β”※添付資料参考
ファイルαの、店舗数は15、商品は10商品程あります。
ファイルβは、商品毎に横方向に1ヶ月分。縦方向に6ヶ月分の欄があります。シート枚数は10枚程です。

ファイル名“β”の上部に日付を入れるセルを設置し、“2024/4/1”もしくは“060401”と入力しマクロボタンを押すと、指定したフォルダ内から、【●●日報060401】というファイルを探す。
【●●日報060401】のシート名“当日”の商品アのA店～F店までの数値は、“β”ファイルのシート名“商品ア”の6か月分の日付の行から4/1を探し、その列に張り付ける。
商品イ以下も、同様の動きをさせたいです。

よろしくお願いいたします。

回答No.2

luka3

日付を入力するセルがどこにあるのか自信が無くて、独立したシートでも、商品のシートでも対応したつもりですが問題があればすみません。
βにあるシート数でループさせようか悩みましたが、上記の問題があったので、シートごとの商品名で処理するようにしました。
店舗名は一切使っておらず、αとβで同じ順番で並んでいる前提です。

Const 日付セル = "A1"
Const 店舗数 = 10

Sub 日付別コピー()
Dim 日付 As Date, filename As String, wb As Workbook, ws As Worksheet
日付 = ActiveSheet.Range(日付セル).Value ' 日付 4/1 を想定　文字列060401の場合は要修正
filename = "●●日報" & Format(日付, "eemmdd") & ".xlsx" ' αファイル名
Set wb = Workbooks.Open(filename:=filename, ReadOnly:=True) ' 読み取り専用で開く
Set ws = wb.Sheets("当日")
商品別コピー "商品ア", 日付, ws
商品別コピー "商品イ", 日付, ws
' 必要数分繰り返し
wb.Close
End Sub

Sub 商品別コピー(商品名 As String, 日付 As Date, ws As Worksheet)
Dim ts As Worksheet, rSrc As Range, rDst As Range
Set ts = ThisWorkbook.Sheets(商品名)
' 商品名と同じ値のセルを探す（コピー元）
Set rSrc = ws.UsedRange.Find(商品名, LookAt:=xlWhole)
' 日付セルと同じ値のセルを探す（コピー先）
Set rDst = ts.UsedRange.Find(日付, LookAt:=xlWhole)
If rDst.Address(False, False) = 日付セル Then Set rDst = ts.UsedRange.FindNext(rDst) ' もしも日付セルだったら再検索
' 店舗数分コピー
rSrc.Offset(1, 0).Resize(店舗数, 1).Copy rDst.Offset(1, 0)
End Sub

回答No.1

t_hirai

恐らく数万円は貰える仕事だと思いますので、ここで答えてくれる人は少ないかと。
クラウドワークスなどで仕事をしてくれる人を探してはどうでしょうか？