はじめに

テストエンジニアや品質保証の現場では、Excelを使ったエビデンス管理が欠かせません。テストケースごとに1枚ずつシートを作り、実行結果やスクリーンショットを貼り付ける運用をしているチームも多いはずです。

しかし、この「シートを手動で増やす」作業は単純ながら手間がかかり、枚数が増えるほどミスも発生しやすくなります。

そこで本記事では、指定した枚数のシートを一括で追加するVBAマクロを紹介します。導入が簡単で、現場ですぐ使える実践的な内容です。

なぜVBAを使うのか

VBA（Visual Basic for Applications）の強みは、Excelだけで完結できる点です。追加のインストールや権限申請が難しい環境でも、「マクロ有効ブック（.xlsm）」として共有するだけで自動化をチームに展開できます。

特に以下のような「決まった操作の繰り返し」に対して、VBAは有効です。

• テストケースごとのシート作成
• シート間の集計、確認結果の集約
• 重要セルの強調表示（赤枠・背景色）
• エビデンス画像の貼り付け位置の統一

こうした定型作業を自動化することで、担当者は「考えるべき作業」に時間を使えるようになります。

💻 現場でよくある課題

テスト案件によっては、数十〜数百のケースを1つのExcelファイルで管理します。その中で

• シートをコピーして命名
• 並び順を整える
• 不足分を追加する

といった作業をすべて手動で行うと、30分〜1時間が平気で消えます。

さらに、手作業には以下のようなリスクがあります。

• シート名のタイポ・重複
• コピー漏れ・ケース抜け
• 命名ルールが人によってバラバラ

これらはすべて、簡単なマクロで防げる問題です。

⚙️ コード例：指定数分シートを追加するマクロ（安定版）

以下は キャンセル対応つき／入力チェックつき／重複名防止つき の実務向け安定版です。

Sub AddSheets_Safe()
Dim i As Long
Dim sheetCount As Long
Dim baseName As String
Dim inputCount As Variant
Dim newName As String

' --- 枚数入力 ---
inputCount = InputBox("追加するシート枚数を入力してください。", "シート追加")

' キャンセル判定（空文字 "" が返る）
If inputCount = "" Then Exit Sub

' 数値が空 or 数値でない
If Trim(inputCount) = "" Then
MsgBox "枚数が入力されていません。", vbExclamation
Exit Sub
End If

If Not IsNumeric(inputCount) Then
MsgBox "数値を入力してください。", vbExclamation
Exit Sub
End If

sheetCount = CLng(inputCount)
If sheetCount <= 0 Then
MsgBox "1以上の数値を入力してください。", vbExclamation
Exit Sub
End If

' --- ベース名入力 ---
baseName = InputBox("追加するシート名のベースを入力してください。", "シート名設定", "TestSheet")

' キャンセル判定
If baseName = "" Then Exit Sub

If Trim(baseName) = "" Then
MsgBox "シート名が入力されていません。", vbExclamation
Exit Sub
End If

' --- シート追加 ---
For i = 1 To sheetCount

newName = baseName & "_" & i

' 重複名チェック
If SheetExists(newName) Then
MsgBox "シート名 """ & newName & """ は既に存在します。" & vbCrLf & _
"処理を中断します。", vbExclamation
Exit Sub
End If

Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = newName
Next i

MsgBox sheetCount & " 枚のシートを追加しました。", vbInformation

End Sub

' --- シート存在チェック用関数 ---
Function SheetExists(sheetName As String) As Boolean
Dim s As Worksheet
SheetExists = False
For Each s In ThisWorkbook.Worksheets
If s.Name = sheetName Then
SheetExists = True
Exit Function
End If
Next s
End Function