VBA・マクロツール

【知らなくても使える】複数シートを一度にたくさん作成するマクロツール(Excel VBA)

Excelファイルでデータ管理などをしている場合は、基にするシートを用いて、大量のシートを一度に作成するという定例作業をすることがあるかと思います。

 

その際に一つずつコピーして作成して、コピーして作成して、、、と何度も同じ作業の繰り返しになってしまっては非常に時間がもったいないです。そのため、一度に複数のシートを作成またはテンプレートシートをコピーできるツール『複数シートの一括作成ツール』をExcelマクロで作成しました。

 

これを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。

ツールの更新履歴

(2023年1月22日:更新)

・全体のUIを変更しました。

 

『複数シートの一括作成ツール』の概要

当ツールであるExcelファイルの表内に作成したいシート名を記入し、必要に応じて基とするシートやシート見出しの色を指定してマクロを実行すると、ツールを実行したExcelファイル、または指定したExcelファイル内に指定したシートが自動作成されます

 

当ツールの使用方法

基本的な機能、操作方法の説明

1.複数シートの一括作成ツールのマクロが入ったExcelファイル(***.xlsm)を開きます。

 

2.表内に作成したいシート名等を入力した状態にして、「シート作成実行」ボタンをクリックします。

 

開いているExcelファイル内または指定したExcelファイル内に指定したシートが作成されます 。

 

Option

Option1:出力先Excelファイルを指定

出力先Excelファイルを指定する場合のみ、該当するセルにパスを含んだファイル名を入力します。

あとは、「シート作成実行」ボタンを押してツールを実行すれば、指定した出力先Excelファイル内に指定したシートが作成されます。

 

Option2:テンプレートにするシート、シート見出しの色をそれぞれ指定

テンプレートにするシートとシート見出しの色を指定する場合は、既にあるシート名や塗りつぶし色をそれぞれ指定します。

テンプレートにするシートに値がない場合は、指定したシート名で空白のシートが挿入されます。

 

留意事項

当ツールを使用するにあたって、出力先Excelファイルの状況によって動作が変わりますので、以下を確認してください。

 

同一のシートが既に存在する場合

・指定したシート名と同一のシートが既に存在する場合は、上書きせず新規シートを作成しません。その場合既に存在するシート名をメッセ―ジで出力します。

 

警告メッセージの出力

・出力先Excelファイルが存在しない、指定したテンプレートが見つからない、指定したシートが既にシートが存在する場合はその旨のメッセージを出力します。

その場合は、警告メッセージが表示されたもの以外のシート作成処理は正常に動作しています。

 

使用する際の事前準備

このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。

 

以下にその手順を説明していきます。

 

準備の手順

1.サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードします。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

 

2.ダウンロードしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE(Visual Basic Editor)を起動させます。

 

3.「ThisWorkbook」をダブルクリックします。

 

4.表示されている右側の欄(エディター)にVBAコードを記載します。

 

VBAのソースコードはこちら

以下のVBAコードをコピーして、「ThisWorkbook」内のエディターに貼り付けます。

※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます

Option Explicit

'-----(設定値)------------------------
Private Const DATA_START_ROW = 11               '1.シート作成表のデータが開始する行番号
Private Const DATA_START_COLUMN = 2             '2.シート作成表のデータが開始する列番号
Private Const BOOK_NAME_POINT = "C5"            '3.対象Excelファイルのセル位置

'-----(メッセージ)-------------------
Private Const Msg1 = "複数シート一括作成処理が正常に終了しました。"
Private Const Msg2 = "出力先Excelファイルを指定してください。"
Private Const WMsg1 = "テンプレートにするシート「"
Private Const WMsg1_2 = "」が見つかりませんでした。"
Private Const WMsg2 = "作成するシート「"
Private Const WMsg2_2 = "」がファイル内に既に存在しています。 "
Private Const WMsg3 = "指定したExcelファイルが見つかりませんでした。"
Private Const WMsg4 = "シート名を入力してください。"
Private Const EMsg1 = "予期せぬエラーが発生しました"
'---------------------------------------

'==========================================================
'シート作成実行ボタンを押した時に実行されるシート作成メイン処理
'==========================================================
Sub シート作成実行_Click()

    On Error GoTo err
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim baseBook As Workbook        '今開いているExcelファイル
    Set baseBook = ActiveWorkbook
    Dim tgtBook As Workbook         '出力先Excelファイル
    Dim tgtBookNm As String         '出力先Excelファイル名
    
    Dim baseSheet As Worksheet      '今開いているExcelファイルのシート
    Set baseSheet = ActiveSheet
    
    Dim tmpSheetNm As String        '表内の「作成するシート名」
    Dim tpltSheetNm As String       '表内の「テンプレートにするシート」
    Dim colorSheetNm As String      '表内の「シート見出しの色」
    
    Dim tmpSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim existTmplFlg As Boolean
    
    Dim msg As String
    
    tgtBookNm = baseSheet.Range(BOOK_NAME_POINT).Value
    
    '指定した出力先Excelファイル名が存在しない場合はエラーメッセージを出力する
    If Dir(tgtBookNm) = "" Then
        MsgBox WMsg3
        Exit Sub
    End If
    
    '対象のExcelファイルが指定されている場合は、当該ファイルを開く
    If tgtBookNm <> "" Then
        Workbooks.Open (tgtBookNm), UpdateLinks:=1
        Set tgtBook = ActiveWorkbook
    Else
        Set tgtBook = baseBook
    End If
    
    'リストの最終行を検索
    lastRow = baseSheet.Cells(Rows.Count, "B").End(xlUp).Row

    If lastRow < DATA_START_ROW Then
        MsgBox WMsg4
        Exit Sub
    End If

    For i = DATA_START_ROW To lastRow
        tmpSheetNm = baseSheet.Cells(i, DATA_START_COLUMN).Value
        tpltSheetNm = baseSheet.Cells(i, DATA_START_COLUMN + 1).Value
        colorSheetNm = baseSheet.Cells(i, DATA_START_COLUMN + 2).Interior.Color
        existTmplFlg = False
        
        ' 指定したシートが既に存在する場合は処理をしない
        For Each tmpSheet In tgtBook.Worksheets
            If tmpSheet.Name = tmpSheetNm Then
                msg = msg & WMsg2 & tmpSheetNm & WMsg2_2 & vbLf
                GoTo Continue
            End If
        Next tmpSheet
        
        'テンプレートシートが指定されている場合はコピーし、指定されていない場合はシートを新規作成する
        If tpltSheetNm <> "" Then
        
            '指定したテンプレートシートが存在しない場合は警告メッセージを表示させて処理をしない
            For Each tmpSheet In tgtBook.Worksheets
                If tmpSheet.Name = tpltSheetNm Then
                    existTmplFlg = True
                End If
            Next tmpSheet
            
            If existTmplFlg = False Then
                If InStr(msg, tpltSheetNm) = 0 Then
                    msg = msg & WMsg1 & tpltSheetNm & WMsg1_2 & vbLf
                End If
                GoTo Continue
            End If
        
            tgtBook.Worksheets(tpltSheetNm).Copy After:=tgtBook.Worksheets(tgtBook.Worksheets.Count)
        Else
            tgtBook.Worksheets.Add After:=tgtBook.Worksheets(tgtBook.Worksheets.Count)
        End If
        
        tgtBook.Worksheets(tgtBook.Worksheets.Count).Name = tmpSheetNm
        tgtBook.Worksheets(tgtBook.Worksheets.Count).Tab.Color = colorSheetNm
        
Continue:
    Next
    
    If tgtBookNm <> "" Then
        tgtBook.Close SaveChanges:=True
    Else
        baseSheet.Activate
    End If
    
    If msg <> "" Then
        MsgBox msg
    Else
        MsgBox Msg1
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
err:
    MsgBox EMsg1
    
End Sub

'==========================================================
'出力先Excelファイルのセルをダブルクリックした際に実行される処理
'==========================================================
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    
    Dim tmp As String
    tmp = Cells(Target.Row, Target.Column).Address(ColumnAbsolute:=False, RowAbsolute:=False)
    
    If tmp <> BOOK_NAME_POINT Then
        Exit Sub
    End If
    
    Dim filePath As String
    Dim fileName As String

    'Excelファイルを指定するダイアログの表示
    filePath = Application.GetOpenFilename(Filefilter:="Microsoft Excelブック,*.xls?", Title:=Msg2)

    If filePath <> "False" Then
        
        Range(BOOK_NAME_POINT).Value = filePath
        
    'キャンセルが選択された場合はダイアログを閉じる
    Else
        Exit Sub
    End If
    
End Sub

 

5.ファイルを保存する際は「Excelマクロ有効ブック」を選択して、保存します。

 

6.「シート作成実行」ボタンにメイン処理「シート作成実行_Click」のマクロを設定します。

 

これで事前準備は完了です。

あとは「基本的な機能、操作方法の説明」で記載された方法でツールを実行できます。

 

なお、当マクロの開発環境は、OS:Windows10 、Excelソフトウェア:Microsoft Office 365となっており、当環境では動作確認ができていますが、他の環境で正常に動作するかは確認できていません。

正常に動作しない場合は、コメントいただければ幸いです。

 

 

また以下にて、このような業務効率化できるツールを機能ごとの一覧でまとめてますので、ご興味のある方はご覧ください。

 

自力で業務効率化できるツール等を作成する場合は、オンラインITスクール」を利用するとモチベーションを保ちつつ、効率的に学習とアウトプットができると思います。

\ 今なら1か月間全額返金保証!! /

上記の「侍テラコヤ」月額2,980円~ という日本最安級の料金でプログラミング学習ができ、今なら初めての方でも安心できる「1か月全額返金保証」があります

自分に合わないと感じた場合は返金してもらえるため、ノーリスクで試すことができます。是非一度体験してみることをオススメします ^ ^

 

ツールのダウンロードはこちら

下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコードをツール内に組み込んで使用してください。

【Excel_VBA】複数シートの一括作成ツール

ツールのダウンロードはこちら

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います

 

<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>