小技プログラミング

新規シートを追加挿入して名前をつける

ExcelVBAを利用して、エクセルの新しいシートを追加挿入&名前をつける方法です。
まずは色々なシートの追加挿入方法です。
WorksheetsオブジェクトのAddプロパティを利用します。

'アクティブシートの一つ前にシートを追加
Worksheets.Add

'シートを先頭に追加
Worksheets.Add Before:=Sheets(1)

'Sheet1シートの前に追加
Worksheets.Add Before:=Worksheets("Sheet1")

'Sheet1シートの後に追加
Worksheets.Add After:=Worksheets("Sheet1")

'3番目に追加(2番目の後ろ)
Worksheets.Add After:=Sheets(2)

'最後尾に追加
Worksheets.Add After:=Sheets(Worksheets.Count)

次にシートに名前を付ける方法です。
WorkSheetオブジェクトのNameプロパティを利用して名前を付けます。
また、既に同じシート名が存在する場合はエラーになりますので注意しましょう。

'アクティブシートに名前を付ける
ActiveSheet.Name = "名前"

'追加したシートに名前を付ける
Dim ws As WorkSheet
Set ws = Worksheets.Add
ws.Name = "名前"

【応用編】
以下はシート内に追加したいファイル名を列挙して、記入された数だけシートを連続追加して名前を付けていくサンプルプログラムです。

①仮に『Sheet1』シートのA列をシート名入力欄とします。
②次に、プログラムを実行させるコマンドボタンを作ります。
ボタンのCaption(表示名)を『シート追加』、オブジェクト名を『btnAddSheets』としました。

③Visual Basic Editor を起動して、Sheet1に以下のコードを記載します。

'オブジェクト名btnAddSheetsのボタンがクリックされた時のアクション
Private Sub btnAddSheets_Click()
Dim intRow As Integer
Dim flg As Boolean
Dim addWs As WorkSheet
Dim chkWs As WorkSheet
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")

'シート名は2行目から入力されるので2で初期化
intRow = 2

'シート名の入力がある限り処理を続けます
Do While ws.Cells(intRow, 1) <> ""

flg = True
'シートの存在チェック
For Each chkWs In Worksheets
If chkWs.Name = ws.Cells(intRow, 1) Then
flg = False
Exit For
End If
Next chkWs
'同じシート名がない場合のみ追加
If flg Then
'最後尾にシートを追加します
Set addWs = Worksheets.Add(After:=Sheets(Worksheets.Count))
'追加されたシートに名前を付けます
addWs.Name = ws.Cells(intRow, 1)
End If
intRow = intRow + 1

Loop
ws.Activate
End Sub

保存して「シート追加」ボタンを押すと、以下のようにシートが追加されます。

"Sheet1"シートのA列の2行目以降に入力された分だけ、新しくシートを追加して、入力されていた値で名前が付けられました。

今回はシートを追加して名前を付ける事プラス、同名シートがある場合にエラーでプログラムが停止してしまいますので既存の名前チェックをしてエラーを回避するようにしています。
エラー自体を無視することもできますが、出来る限りエラー処理を組み込むようにしておくとトラブルの早期発見と改善に繋がります。