【Excel VBA】指定したテーブル付きシートをコピーして今日の日付のyymmdd形式名でシートとテーブルを作成するExcelマクロ

PC

こんにちは。マクロ修行中のNOOWIです。

最近、Excel VBAに本格的に手を出し始めました。

以前から我流で作っていたのですが、最近基本をみっちり学ぶ機会があり、仕事にも活かせそうだったのでちょっとまじめにやってみようかな、と。

さて、今日は会社の別部署の人のプライベートな依頼絡みで作ったマクロを書いてみます。

修行中なのでプロから見たら粗いところもあると思いますが、ご容赦。

指定したテーブル付きシートをコピーして今日の日付でyymmdd形式のシートとテーブルを作成するVBAコード

例えば今日は2015/11/28なので、「151128」というシート名でワークシートをコピーし、その中にあるテーブルを「t-151128」という名前にします。
※なお、以下のシートは「template」という名前のシートをコピーするように設定しています。

Option Explicit '関数宣言の強制

Sub Dailycopy()
    '3つの変数を宣言。
    Dim int1 As Integer 'はい/いいえの選択用
    Dim ws_1 As Worksheet, bl_1 As Boolean '作る予定のシートが被らないか調べる用

    int1 = MsgBox("今日の日付で入力シートを作りますか?", vbYesNo, "今日のシート作成")
    'ここからはい/いいえで処理を分ける
    If int1 = vbYes Then
        '作る予定のシートと同じ名前のシートがないか調べる
        For Each ws_1 In Worksheets
            If ws_1.Name = Format(Date, "yymmdd") Then
                'もしすでに同じ名前のシートがあるのなら「bl_1」はTrueにする
                bl_1 = True
            End If
        Next ws_1
        'bl_1=trueならシート作成済みとして何も行わない
        If bl_1 = True Then
            MsgBox "すでに今日のシートは作成済みです"
        '同じ名前のシートがなかったら一番右のシートをコピー。
        Else
            ThisWorkbook.Worksheets("template").Copy after:=ThisWorkbook.Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = Format(Date, "yymmdd")
            'コピーしたシートの中のテーブルを「t_[日付]」という名称に変更する
            Worksheets(Worksheets.Count).ListObjects(1).Name = "t_" & Format(Date, "yymmdd")
        End If
    Else
        MsgBox "キャンセルしました"
    End If
End Sub

なお、テーブルがないシートをコピーしようとするとエラーが出る可能性がありますので、その場合は「Worksheets(Worksheets.Count).ListObjects(1).Name = “t_” & Format(Date, “yymmdd”)」を外すようにしてください。

時間があったらここでもまた何かコードを書いてみようかな。

コメント