【VBA】特定のシートだけを別名ファイルで名前をつけて保存する

今回の記事では、Excelファイル内に複数のシートがある場合に、その中の特定のシートを別ファイルとして名前を付けて保存するサンプルマクロをご紹介します。

上記画像のように、Sheet1、Sheet2、Sheet3の3つのシートがあるファイルから、別ファイルにSheet2をコピーして名前を付けて保存するVBAコードを書いてみましたので、紹介します。

この記事で紹介するマクロは、構文が完璧ではない可能性もありますので、ご自身の責任で使用してください。参考程度にお願いいたします。

書いてみたマクロ

Excelファイル内の特定のシートを別ファイルとして保存していきます。

作成したマクロの流れです。まず、ユーザーが保存するシート名を指定し（※1部分）、そのシートを選択します。次に、保存ダイアログを表示して、ユーザーに保存先とファイル名を指定（※2部分）させます。ユーザーが保存をキャンセルした場合は、処理が中断され、メッセージが表示されます。最後に、選択されたシートを新しいファイルとして保存し、ファイルを閉じます。

Sub sample()
  ' 特定シートを別ファイルで名前を付けて保存する

  ' 定義
  Dim Save_File As Variant

  ' 別ファイルに出力するシートを選択
  Sheets("シート名※1").Select

  ' 名前を付けて保存するためにダイアログ表示
  Save_File = Application.GetSaveAsFilename(InitialFileName:="名前を指定してください※2", _
  FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")
  
  ' 保存ダイアログでキャンセルを押した場合の処理
  If Save_File = False Then
      MsgBox "保存がキャンセルされました。"
      Exit Sub
  End If

  ' シートのコピー、ファイル保存
  Sheets("シート名※1").Copy
  ActiveWorkbook.SaveAs Filename:=Save_File, FileFormat:=xlOpenXMLWorkbook

  ' ファイルを閉じる
  ActiveWorkbook.Close

End Sub

「※」部分についての補足説明を入れておきます。

※1	複製したいシート名を指定
※2	保存ダイアログに表示される初期のファイル名

使用例

Sheet1、Sheet2、Sheet3の3つのシートが存在するExcelファイルから、Sheet2を別ファイルとして名前を付けて保存する使用例です。保存ダイアログの初期ファイル名には、「名前を指定してください」という名前が入るように設定しました。

Sub sample()
  ' 特定シートを別ファイルで名前を付けて保存する
  
  ' 定義
  Dim Save_File As Variant

  ' 別ファイルに出力するシートを選択
  Sheets("Sheet2").Select

  ' 名前を付けて保存するためにダイアログ表示
  Save_File = Application.GetSaveAsFilename(InitialFileName:="名前を指定してください", _
  FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")
  
  ' ユーザーがキャンセルを押した場合の処理
  If Save_File = False Then
      MsgBox "保存がキャンセルされました。"
      Exit Sub
  End If

  ' シートのコピー、ファイル保存
  Sheets("Sheet2").Copy
  ActiveWorkbook.SaveAs Filename:=Save_File, FileFormat:=xlOpenXMLWorkbook

  ' ファイルを閉じる
  ActiveWorkbook.Close

End Sub

、実行時は以下のようなダイアログとなります。（ファイル名の初期値の名前をもっと分かりやすいものにすれば良かったかもです…！）

さいごに

いかがだったでしょうか。マクロ作りの参考に少しでもなれば幸いです。

余談ですが、保存ダイアログ表示時に、以前はキャンセルの処理を入れておらず、キャンセルボタンを押下すると「FALSE.xlsx」が勝手にできてしまうという状況がありました。時間ができたので、キャンセル処理を追加しました。

それでは、また！