📋

CopySheetToNewWorkbook

シート管理

指定したシートを新しいブックにコピーする

🎬 デモGIF準備中

📖 使い方

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

💡 実行例：実行するとコピー元のシート名を入力し、新しいブックが作成される

💻 VBAコード

' CopySheetToNewWorkbook
' -----------------
' Macro Name: CopySheetToNewWorkbook
' Description: 指定したシートを新しいブックにコピーする
' Parameters: なし
' Returns: なし
' Usage: 実行するとコピー元のシート名を入力し、新しいブックが作成される
' -----------------

Sub CopySheetToNewWorkbook()
    Dim ws As Worksheet
    Dim newWb As Workbook
    Dim sheetName As String
    Dim savePath As String
    Dim fileFormat As XlFileFormat

    On Error GoTo ErrorHandler

    sheetName = InputBox("新しいブックにコピーするシート名を入力:", "シートコピー", ActiveSheet.Name)

    If sheetName = "" Then
        Exit Sub
    End If

    On Error Resume Next
    Set ws = Worksheets(sheetName)
    On Error GoTo ErrorHandler

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

    ws.Copy

    Set newWb = ActiveWorkbook

    savePath = InputBox("保存先のパスを入力:" & vbCrLf & "(空欄の場合はデスクトップに保存)", "保存先指定", Environ("USERPROFILE") & "\Desktop\" & sheetName & ".xlsx")

    If savePath = "" Then
        newWb.Close SaveChanges:=False
        MsgBox "キャンセルされました。", vbInformation
        Exit Sub
    End If

    fileFormat = xlOpenXMLWorkbook

    On Error Resume Next
    newWb.SaveAs Filename:=savePath, FileFormat:=fileFormat
    On Error GoTo ErrorHandler

    If Err.Number <> 0 Then
        newWb.Close SaveChanges:=False
        MsgBox "ファイルの保存に失敗しました: " & Err.Description, vbCritical
        Exit Sub
    End If

    MsgBox "「" & sheetName & "」を新しいブックにコピーしました。" & vbCrLf & savePath, vbInformation
    Exit Sub

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

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