無料VBA講座

● Workbook＿Openは、ファイルを開いたときにプログラムを実行する。

TM = Month(Date) 　　　　　　　　　　　' 本日の日付関数から月を取出し、TM に代入する。
If TM = 12 And Sheets(集計表") .Range("A1") = 0 Then　　　　　　　　　　　　
　　　　　　　　　　　　　　　　　　　　 ' 今月が12月で集計表のA1が 0 なら
　Sheets("集計表") .Range("A1") .Value = 1
　　　　　　　　　　　　　　　　　　　　 ' 集計表のA1を 1 にする。これは12月に一度実行したものを
　　　　　　　　　　　　　　　　　　　　 ' 再度実行させないための識別文字である。
　　　　　　　　　　　　　　　
　GoTo Jump　　　　　　　　　　　　　　' Jump へジャンプする。
End If
If　TM = 11 Then Sheets("集計表") .Range("A1") .Value = 0
　　　　　　　　　　　　　　　　　　　　 ' これは、12月には必ず 0 になっているように、11月になったら
　　　　　　　　　　　　　　　　　　　　 ' 0 にしている。

Exit Sub　　　　　　　　　　　　　　　　 ' 今月が12月でなかったらプログラムを終わる。

Jump :　　　　　　　　　　　　　　　　　' 今月が12月なら実行する。(これは、毎日開かないファイルでも
　　　　　　　　　　　　　　　　　　　　 ' 12月になって開くと、実行されるので12月中に開かれれば良い)
　Sheets("集計表") .Select
　intCol = Range("B3") .End(xlToRight) .Colmun
　　　　　　　　　　　　　　　　　　　　 ' B3データの右端の列番号を intCol に代入する。
　　　　　　　　　　　　　　　　　　　　 ' intCol = 8
　intYar = Left(Cells(3, intCol), 4)　　　　' 3行目の8列目の文字列の、左から4文字を intYar に代入する。
　　　　　　　　　　　　　　　　　　　　 ' intYar = 2018

　Cells(3, intCol + 1). Value = intYer + 1 & "年"
　　　　　　　　　　　　　　　　　　　　' 3行目の9列目に記入する。2018+1 と年を。2019年である。

　intN = intYar + 1 　　　　　　　　　　' 新しく作るシート名を 2018 + 1 にする。

　strN = intN　　　　　　　　　　　　　 ' 加算するために、intN の年は数値に定義しているが、シート名は
　　　　　　　　　　　　　　　　　　　 ' 文字列が必要だから、string の定義に再度代入している。

　Sheets .Add after : Sheets(Sheets .Count)　　' 新しい Sheet2 シートができた。
　strN3 = Range("A1") .Parent .Name　　　　　' 出来たシート名が何かわからないので、strN3 に代入して
　　　　　　　　　　　　　　　　　　　　　　　 ' いる。
　Sheets(strN3) .Name = strN　　　　　' Sheet2 を 2019にシート名を変更した。
　strN4 = intYar 　　　　　　　　　　　 ' 2018のシートに移動する必要があるので、intYar を文字列に代入
　　　　　　　　　　　　　　　　　　　 ' している。
　Sheets(strN4) .Select　　　　　　　　' 2018シートを選択している。
　Range("B2 : J16") .Select
　Selection .Copy
　Sheets(strN) .Select
　Range("B2") .Select
　Selection .PasteSpecial Paste : xlPasteFomats ,Operation : xlNone ,SkipBlanks : False , _
　　　Transpose : = False
　　　　　　　　　　　　　　　　　　　　' B2に形式だけの貼り付けをする。枠線だけがコピーされる。
　Range("C2") .Value = intN 　　　　　　' C2の年を書く位置に2019と書かれた。
　Sheets(strN4) .Select
　Range("B3:J3") .Select　　　　　　　 ' 2018のシートでB3からJ3までを
　Selection .Copy 　　　　　　　　　　' コピーして
　Sheets(strN) .Select 　　　　　　　　　 ' 2019のシートを選択して
　Range("B3") .Select
　ActiveSheet .Paste　　　　　　　　　　 ' B3に貼り付ける。（項目フィールド）

　Range("D2") .Value = "年 1月度仕入" 　' D2に一月と記入する。2019のシ－トには1月から12月までの
　　　　　　　　　　　　　　　　　　　　 ' データ範囲が必要なので、プログラムの追加が必要です。
　Application .CutCopyMode = False　　 ' コピーモードを終了する。

　　　　　　　　　　　　　　　　　　　　　　　　　　　