Sub セルをシート3にコピー()
Dim シート1 As Worksheet
Dim シート3 As Worksheet
Dim 最終行 As Long
Dim 現在日付 As String
Dim i As Long
' シート1とシート3のワークシートを取得
Set シート1 = ThisWorkbook.Sheets("Sheet1")
Set シート3 = ThisWorkbook.Sheets("Sheet3")
' シート3の最終行を取得
最終行 = シート3.Cells(シート3.Rows.Count, 1).End(xlUp).Row
' 現在の日付を取得
現在日付 = Format(Date, "yyyy-mm-dd")
' シート3に日付を入力
シート3.Cells(最終行 + 1, 1).Value = 現在日付
' シート1のB3、B6、B9、B12、B20の固定値をシート3にコピー
シート1.Range("B3").Copy シート3.Cells(最終行 + 1, 2)
シート1.Range("B6").Copy シート3.Cells(最終行 + 1, 3)
シート1.Range("B9").Copy シート3.Cells(最終行 + 1, 4)
シート1.Range("B20").Copy シート3.Cells(最終行 + 1, 12)
' 変動する12行目から14行目までをコピー
For i = 12 To 14
If Range("B12").Value <> "" Then '12行目をコピー
シート1.Range("B12：E12").Copy シート3.Cells(最終行 + 1, 5)
Exit For
ElseIf Range("B13").Value <> "" Then '13行目をコピー
シート1.Range("B13：H13").Copy シート3.Cells(最終行 + 1, 5)
Exit For
End If
Next i
End Sub
