[[20250418135805]]　『sheet1の表データをsheet2の一か月分の表の当日に』（生徒）　ページの最後に飛ぶ

『sheet1の表データをsheet2の一か月分の表の当日に反映する方法』（生徒）

sheet1
毎日同じ表に当日のデータを入力する
（１列13行・加算関数使用有）
sheet2
ひと月分の表（1週間ごとに5行）

【現在】
毎日sheet1の表にその日のデータを入力
表（１列13行）をコピー
sheet2の表の当日の位置にsheet1のデータを貼り付け
sheet1のデータを消去
次の日にsheet1の表の同じ位置にデータを入力
以下連日繰り返し

【この先】
手動でコピーペーストしているところを自動でできるようにしたいです。
sheet1のデータをsheet2の当日の日付のところに自動で反映し毎日蓄積されるようにしたい。また、反映後sheet1のデータを消去してもsheet2のデータが消えないようにしたいです。
何か方法はありませんか。

＜使用 Excel：unknown、使用 OS：unknown ＞

全自動ならVBA～♪。。。(*^^*)/////
Sheet1
Sheet2
のフォーマット詳細を今少し教えて戴けると何かお手伝いくらいは
できるかもぉ～。。。しれません。お役に立てないかもしれませんが^^;
でわ
m(__)m

（隠居Z） 2025/04/18(金) 15:37:30

返信がコメントできていませんでした。
遅くなり申し訳ありません。

訂正
※sheet1
１列13行→1列38行
※sheet2
ひと月分の表（1日～末日まで一列ずつ）

sheet1
P2～P39の表に毎日数値データを入力する
例　4/1　3/31に記入したP2～P39データを消し、4/1のデータを入力する
　　4/2　4/1に記入したP2～P39データを消し、4/2のデータを入力する

sheet2　　　　　　　　　　　　　　　　　　　　　　
3行目は1日～末日迄一列ごとに日付が記入されている（4/1　4/2　4/3～）休日含む
C列から末日の4～41迄、日付の下が表になっている
例　4/1　C4～C41　　sheet1の表をコピーし、C4～C41に張り付ける
　　4/2　D4～D41　　sheet1の表をコピーし、D4～D41に張り付ける
　　4/3　E4～E41　　sheet1の表をコピーし、E4～E41に張り付ける

毎日追加されていく
張り付けた後sheet1の表を消してもsheet2のデータは残る
コピーして貼り付ける工程を自動で行えるようにしたいです

（生徒） 2025/05/01(木) 14:03:26

複雑ではないのでマクロ記録でもしてみては。
（?） 2025/05/01(木) 14:37:37

 Option Explicit
Private Sub MoveDataFromWs1ToWs2()
    Dim app, lC&, i&, x, dAry(), ra, AcceptYmd#
    Rem ddmk
    AcceptYmd = DateSerial(2025, 5, 5)
    Set app = Application
    Set ra = Worksheets("Sheet1").Range("P2:P39")
    If app.Sum(ra) = 0 Then
        MsgBox "入力情報が有りません"
        Exit Sub
    End If
    With Worksheets("Sheet2")
        lC = .Cells(3, .Columns.Count).End(xlToLeft).Column
        Select Case True
            Case lC > 3 And lC < .Columns.Count
                dAry = .Range(.Cells(3, 3), .Cells(3, lC)).Value2
            Case lC = 3
                ReDim dAry(1 To 1, 1 To 1)
                dAry(1, 1) = .Cells(3, 3).Value2
            Case lC < 3
                MsgBox "情報が異常です"
                Exit Sub
        End Select
        x = app.Match(AcceptYmd, dAry, 0)
        If Not IsError(x) Then
            .Cells(3, 3 + x - 1).Offset(1).Resize(ra.Rows.Count) = ra.Value
        Else
            MsgBox "指定した日付が有りません"
        End If
    End With
    Erase dAry
End Sub

2025年五月度で書いてみました
こんな、感じでしょうか。。。(*^^*)
m(__)m
（隠居Z） 2025/05/01(木) 19:12:46

 Undoができないので、私ならまず実行の確認をします。
 例えば...

 Sub test()
    Dim x
    If MsgBox(Format$(Date, "m月d日") & "分のデータを移行しますか?", vbQuestion) <> vbOK Then Exit Sub
    x = Application.Match(CLng(Date), Sheets("sheet2").Rows(3), 0)
    If IsError(x) Then Beep: MsgBox "Sheet2の3行目に対応する日付の列が在りません", vbCritical: Exit Sub
    With Sheets("sheet1").[p2:p39]
        Sheets("sheet2").Cells(4, x).Resize(.Rows.Count).Value = .Value
        .ClearContents
    End With
End Sub

 修正:
 Sheet2の3行目に4/1から翌年の3/31まで記載済み、というですか?
 >（１列13行・加算関数使用有）を見逃し
 2025/05/04 13:10
（jindon） 2025/05/01(木) 20:45:19

隠居Zさん、ありがとうございます！
出来ればやり方を詳しく教えていただけないでしょうか。
どこに記入すればいいのか等・・・
お手数をお掛け致しますが宜しくお願いします。

（生徒） 2025/05/09(金) 14:58:04

jindonさん、ありがとうございます！
宜しければ詳しく教えていただきたいです。
因みに、
sheet一つにつき１か月分の記載をしています。
例　sheet2　4月分
　　sheet3　5月分
　　sheet4　6月分

（生徒） 2025/05/09(金) 14:58:37

 1) Alt + F11 で vbe(Visual Basic Editor) を起動
 2) 右空白部分に下記コードを張り付ける

 Sub test()
    Dim x, s$
    If MsgBox(Format$(Date, "m月d日") & "分のデータを移行しますか?", vbQuestion) <> vbOK Then Exit Sub
    s = Format$(Date, "m""月分""")
    If Not Evaluate("isref('" & s & "'!a1)") Then MsgBox s & " 用シートがありません", vbCritical: Exit Sub
    x = Application.Match(CLng(Date), Sheets(s).Rows(3), 0)
    If IsError(x) Then Beep: MsgBox "Sheet2の3行目に対応する日付の列が在りません", vbCritical: Exit Sub
    With [p2:p39]
        Sheets(s).Cells(4, x).Resize(.Rows.Count).Value = .Value
        .ClearContents
    End With
End Sub

 3) Alt + F11 でエクセル画面に戻る

 4) Alt + F8 でマクロ一覧を表示して test を選択し[実行]

 私なら 4) を省くために
 5) [挿入] - [図形] - 適当なものを選択してシート上に配置
 6) 5) を選択して右クリック -[マクロの登録] - testを選択してOK

 図形をクリックするとマクロが実行されます。
（jindon） 2025/05/09(金) 15:46:43

jindonさん
詳しく説明してくださってありがとうございます。
わかりやすい説明のおかげで出来そうな気がします！
頑張ってやってみます！
（生徒） 2025/05/19(月) 16:02:55

コメント返信：

[ 一覧(最新更新順) ]

[[20250418135805]] 『sheet1の表データをsheet2の一か月分の表の当日に』（生徒） ページの最後に飛ぶ

[[20250418135805]]　『sheet1の表データをsheet2の一か月分の表の当日に』（生徒）　ページの最後に飛ぶ