VBA 今日の行にあるセル コピー 別シートへ

質問

(1)sheet1にボタン　button1 があり、そのボタンを押すと、マクロが起動する。
(2)データは　sheet2　貼り付け先は　sheet3

sheet2　F列に日付が入っています。
　　F列は、日付（過去～本日まで　※未来の日付はありません）か、空白の場合があります。

F列の日付が本日のとき、
sheet2 A列のセルの値を　sheet3 B列へ。　　A列には連番。
sheet2 D列のセルの値を　sheet3 C列へ。
sheet2 G列のセルの値を　sheet3 D列へ。
sheet2 F列のセルの値を　sheet3 E列へ。

それぞれ、Sheet3の各行の一番下に貼り付ける形をとりたいのです。

こちらでマクロはどうしたらよいのでしょうか。

回答No.1

tom04 · ベストアンサー

こんにちは！
一例です。

前提条件として
Sheet2・Sheet3とも1行目は項目行でデータは2行目以降に入っている
または2行目以降に表示する！としています。

Private Sub CommandButton1_Click()
Dim i As Long, wS2 As Worksheet, wS3 As Worksheet
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
For i = 2 To wS2.Cells(Rows.Count, "A").End(xlUp).Row
If wS2.Cells(i, "F") = Date Then
With wS3.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Value = .Row() - 1
.Offset(, 1) = wS2.Cells(i, "A")
.Offset(, 2) = wS2.Cells(i, "D")
.Offset(, 3) = wS2.Cells(i, "G")
.Offset(, 4) = wS2.Cells(i, "F")
End With
End If
Next i
End Sub

※　Sheet3の各列の表示形式は設定しておいてください（日付列など）
※　「本日」のデータは複数ある！という前提のコードです。
※　ループさせていますので、Sheet2のデータ量が数千・数万行の場合は
別方法（オートフィルタ当）を使った方がはやいかもしれません。

こんなんではどうでしょうか？m（_ _）m

お礼

ありがとうございます！！
大変助かりました！！！

例もあまりちゃんと挙げずに、質問してしまったのに、すばやく回答いただけて、
大変ありがとうございました！
無事に作成をすることが出来ました。

ありがとうございました。