適材適所

WindowsやPowerShellやネットワーク、IBMなどのシステム系の話やポイ活など気になったことも載せているブログです。

Excel VBAで名前を指定してシートを大量に新規作成する

テンプレート的なシートをコピーして沢山作らなくてはいけない・・・。

手作業でやってたら日が暮れる・・・。

あぁ、せっかく作ったのに、間違えてる・・・。

最初から作り直しだ・・・。

こんなの人がやる作業じゃねえええええ!!!

その作業、1秒で終わるよ。

そう。VBAならね。

一覧からシートを新規に作成するコード

そういうときは、あらかじめ設定したい名前を設定用のシートに全て準備しておいて、シートを新規作成しつつ、そこからシート名拾って名前を付けてあげましょう。

百聞は一見に如かず。

こんな感じです。

listシートにtest1~test15のシートがあります。

このlistシートの値を持ったtest1~test15という名前のシートを作成するコードです。

listワークシート

test1
test2
test3
test4
test5
test6
test7
test8
test9
test10
test11
test12
test13
test14
test15
 
Sub createNewSheetFromList()
    
    '行数用の変数
    Dim i As Long
    'リストシート
    Dim listSheet As Worksheet: Set listSheet = Worksheets("list")
    '最終行を格納する変数
    Dim maxRow As Long: maxRow = listSheet.Cells(Rows.Count, 1).End(xlUp).Row
    '新しいシート名を格納する変数
    Dim sheetName As String
    '新しいシートを格納する変数
    Dim newSheet As Worksheet
    
    For i = 1 To maxRow
        sheetName = listSheet.Cells(i, 1).Value
        'WorkSheets.Addメソッドは戻り値で
        'Worksheetオブジェクトを返すので変数に格納する
        Set newSheet = Worksheets.Add
        'シート名を変更する
        newSheet.Name = sheetName
    Next i
    
End Sub

listシートを準備して、先ほどのコードを実行してみると・・・

f:id:shinmai_papa:20200915170027p:plain

新しいシート(test1~test15)が作成されました!

f:id:shinmai_papa:20200915170034p:plain

これを基本にして、今度はテンプレートとなる、ひな形シートをコピーする応用編です。

ひな形をコピーして新規にシートを作成するコード

先ほどの新規にシートを追加するコードの応用で、次はひな形のシートをコピペして新規シートを作成するコードです。

リストは先ほどのlistシートを使用します。

ひな形となるシートはtemplateシートとして同じブックに準備します。

templateシート

f:id:shinmai_papa:20200915170041p:plain

ただテンプレートをコピーするだけでは芸がないので、さらなる応用のヒントとしてシート名の横のB2セルには、各シートの名前を入れてみます。

 
Sub createNewSheetFromListUsingTemplate()
    
    '行数用の変数
    Dim i As Long
    'リストシート
    Dim listSheet As Worksheet: Set listSheet = Worksheets("list")
    '最終行を格納する変数
    Dim maxRow As Long: maxRow = listSheet.Cells(Rows.Count, 1).End(xlUp).Row
    '新しいシート名を格納する変数
    Dim sheetName As String
    '新しいシートを格納する変数
    Dim newSheet As Worksheet
    'ひな形となるシートを格納する変数
    Dim templateSheet As Worksheet: Set templateSheet = Worksheets("template")
    
    For i = 1 To maxRow
        sheetName = listSheet.Cells(i, 1).Value
        'WorkSheets.copyメソッドは何も返さないので変数に格納できない!
        templateSheet.Copy after:=templateSheet
        '新しく追加されたシートはアクティブになっているので
        'ActiveSheetオブジェクトを利用する
        Set newSheet = ActiveSheet
        'シート名を変更する
        newSheet.Name = sheetName
        'B2にシート名を入力する
        newSheet.Range("B2").Value = sheetName
    Next i
    
End Sub

実行すると・・・

f:id:shinmai_papa:20200915170045p:plain

ひな形をコピーして、シートが新規で作成され、B2にシート名が入力されました。

newSheet.Range("B2").Value = sheetName

この部分を変更すれば、ひな形シートから値を変えつつ新規作成することできます。

注意点

一覧は重複がない前提ですので、一覧に重複があるとエラーになります。

f:id:shinmai_papa:20200915170052p:plain

シート名を変更するときにエラーになりますので、ご注意ください。

コピペして利用される場合は、初期処理として一覧の重複チェックが必要かと思います。

終わりに

Excelのシートをコピーして値を変えて、またコピーして・・・

延々とこんな作業をしている人、ぜひこのコードを使って業務を自動化してください!

パソコンの作業はどんどん自動化して、楽をしてほしいと思います。

ここまでお読みいただきありがとうございました。

VBAに面倒なことをやらせてる他の記事

www.tekizai.net

www.tekizai.net

www.tekizai.net

www.tekizai.net