📋

CopySheet

シート管理

シートを複製する

ワークシートを同一ブック内または別のブックにVBAでコピーするマクロです。Worksheet.Copyメソッドを使って指定した位置にシートを複製し、名前変更も自動で行えます。テンプレートシートから月別・案件別のシートを量産する処理などに最適です。書式・数式・データをすべて保持したまま複製されるため、手動コピーの手間を大幅に削減できます。内部ではWorksheet.CopyメソッドのBefore/After引数で挿入位置を指定しており、コピー後は自動的にコピー先シートがアクティブになる仕様を利用してRenameSheetと連続実行すればテンプレート展開が1つの流れで完結します。CopySheetToNewWorkbookが別ブックへの切り出しであるのに対し、本マクロは同一ブック内での複製に特化しています。

📖 使い方

VBAエディタを開く（Alt + F11）
モジュールを挿入（挿入 > モジュール）
下記VBAコードをコピー&ペースト
ブック上で実行（Alt + F8 でマクロ選択）

💡 実行例：実行するとコピー元のシート名と新しいシート名を入力するダイアログが表示される

🎯 活用シーン

✓月次レポートテンプレートから12ヶ月分のシートを一括生成
✓案件管理テンプレートを新規案件ごとに複製して展開
✓年度末に翌年用のシートを今年分からコピーして初期化
✓案件ごとに同じ構成のシートを大量に複製して管理台帳を拡張したいとき
✓週次報告テンプレートを毎週コピーして、当週分の入力シートとして使い回したいとき

💡 実装のヒント

▸Before/After引数でコピー先の位置を指定します
▸コピー後はActiveSheetがコピーされたシートになります
▸別ブックにコピーするにはCopy After:=Workbooks("ファイル名").Sheets(1)のように指定します
▸多数のシートを連続コピーする場合は、コピー先の名前重複を避けるため、ループ内で命名規則に連番を含めることをお勧めします。
▸グラフやピボットテーブルを含むシートをコピーする場合、参照元データの範囲がずれないか事前に確認してください。

💻 VBAコード

' CopySheet
' -----------------
' Macro Name: CopySheet
' Description: シートを複製する
' Parameters: なし
' Returns: なし
' Usage: 実行するとコピー元のシート名と新しいシート名を入力するダイアログが表示される
' -----------------

Sub CopySheet()
    Dim sourceWs As Worksheet
    Dim newWs As Worksheet
    Dim sourceName As String
    Dim newName As String
    Dim i As Long

    On Error GoTo ErrorHandler

    sourceName = InputBox("コピーするシート名を入力:", "シートコピー", ActiveSheet.Name)

    If sourceName = "" Then
        Exit Sub
    End If

    On Error Resume Next
    Set sourceWs = Worksheets(sourceName)
    On Error GoTo ErrorHandler

    If sourceWs Is Nothing Then
        MsgBox "「" & sourceName & "」は存在しません。", vbExclamation
        Exit Sub
    End If

    newName = InputBox("新しいシート名を入力:", "シートコピー", sourceName & "_Copy")

    If newName = "" Then
        Exit Sub
    End If

    For i = 1 To Worksheets.Count
        If StrComp(Worksheets(i).Name, newName, vbTextCompare) = 0 Then
            MsgBox "「" & newName & "」は既に存在します。", vbExclamation
            Exit Sub
        End If
    Next i

    sourceWs.Copy After:=sourceWs
    Set newWs = ActiveSheet
    newWs.Name = newName

    MsgBox "「" & sourceName & "」を「" & newName & "」としてコピーしました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

🔗 同カテゴリの関連マクロ