複数シートを別ブックへ移動して保存するマクロ | エクセルマクロ(VBA)実践蔵(じっせんぐら)
- エクセルマクロ(VBA)実践蔵 >
- 項目一覧 >
- 複数シートを別ブックへ移動して保存するマクロ
複数シートを別ブックへ移動して保存するマクロ最終更新日：2023-05-29
このページの目次
エクセルの見た目と操作手順⁽ユーザインターフェース
マクロ有効ブック上で作業を行い、結果ファイルは、通常のエクセルファイルで保存したいという場合は、多いかと思うので、マクロ有効ファイルのシートを通常エクセルファイルへ保存するマクロを考えていこうと思います。
シート名を「実行」とつけていますが、変更可能です。他のマクロと共存する場合は「シート移動」の方が適切かもしれません。
シートの移動先を、新規ブックか既存ブックかを選択できるようにする。
「既存ファイル」へシートを移動させる場合は、ファイル参照ダイアログを使用して、既存のエクセルファイルパスを取得できるようにする。（上の図5～7行目参照）
「新規ファイル」へシートを移動させる場合は、フォルダ選択ダイアログを使用して、フォルダを選択できるようにする。また、作成するファイル名もセルから指定できるようにする。⁽下の図 9～13行目参照⁾
次に、「シート名を下のリストに取得」ボタンを押下し、操作中のこのエクセルマクロ有効ファイル内に存在するシート名一覧を作成する。（操作中の実行シートは除く）
処理が終わると、上記のようにシート名がリストに入る。このリストは複数選択を可能とし、デフォルト状態では、選択中の状態になっている。選択中のシート名が移動対象シートとなる。
除外したいシート名をクリックして、選択状態を解除し、実行ボタンを押下することによって、指定のブックへシートを移動し、保存する。
同じ名前のシートが移動先に存在する場合、差し替えを行うかを問うメッセージボックスを表示させる。
差し替えを選択した場合は、移動先ブック内の同名シートを削除し、マクロ有効ブック内のシートを移動し、処理を継続する。差し替えを行わない選択をした場合は、処理の中断となり、ブックを２つとも開いた状態で停止する。
シート名リストを取得後に、マクロ有効ブック内のシート名を変更した場合は、「一致するシートが存在しないため、最新のシート名を取得しなおして、再度実行してください。」というメッセージが表示される。
作成手順
エクセル表側
ファイル参照の作成方法は、こちら。 フォルダ参照の作成方法はこちら。
ファイル参照とフォルダ参照ボタンを設置し、新規ファイル名を指定できるD12セルを用意する。
ActiveXのオプションボタンを2つ配置し、「既存ファイルに追加」ボタンと「新規ファイルに保存」ボタンを配置する。
「既存ファイルに追加」オプションボタンがクリックされた場合のマクロは、上図の5行目から7行目を表示させ、9行目から13行目までを非表示にさせる。逆に「新規ファイルに保存」オプションボタンがクリックされた場合は、図の5行目から7行目を非表示に変更し、9行目から13行目までを表示にさせる動作とする。
ActiveXのオプションボタンのプロパティからオブジェクト名を「既存ブックButton」と「新規ブックButton」に変更する。（下の図参照）
少し余談になりますが、VBAは関数名やメソッド名、変数名に日本語を設定可能です。フォームコントロールのボタンにマクロを登録する際やマクロの実行から呼び出す場合に、マクロのSub関数名に日本語を含めておくと、マクロ一覧から選びやすくなります。今回は、ActiveXのオプションボタンのため、マクロ登録は行いませんのでどちらでもお好みでどうぞ。ActiveXは、マクロの登録は行わずに、命名規則に従ってSub関数名を作ることで呼び出される。
Visual Basic側にエクセルマクロ(Excel VBA)の記述
下記はシートオブジェクトに記載します。そのため、行(Rows)を操作する時に、シート名を省略して記述しています。標準モジュールに記載する場合は、どのシートが対象なのかを明記する必要があります。
ActiveXのオプションボタンは、オブジェクト名と同一の名で後ろに「_Click()」をつけると名前で関連付けられて、クリック時に呼び出されます。（ActiveXはマクロ登録が不要。ただし、命名規則に従う必要がある。）
Private Sub 既存ブックButton_Click()
If 既存ブックButton.Value = True Then
'未選択状態から選択された
'5行目～7行目を表示する
'9行目～13行目を非表示にする
Rows("5:7").EntireRow.Hidden = False
Rows("9:13").EntireRow.Hidden = True
Call シート名取得_Click
End If
End Sub
Private Sub 新規ブックButton_Click()
If 新規ブックButton.Value = True Then
'未選択状態から選択された
'5行目～7行目を非表示する
'9行目～13行目を表示にする
Rows("5:7").EntireRow.Hidden = True
Rows("9:13").EntireRow.Hidden = False
Call シート名取得_Click
End If
End Sub
上記から呼び出している シート名取得_Clickは、なくても問題ありません。「シート名を下のリストに取得」ボタン押下時の処理を呼び出している。戻り値の無い関数は、Callを使用して呼び出す。
次に、フォームコントロールのボタンを作成し、右クリック「テキストの編集」で「シート名を下のリストに取得」を設定する。ActiveXとフォームコントロールの違いはマクロで制御を行えるかどうかの違いとなる。マクロで制御したい場合は、ActiveXが必須になる。フォームコントロールは初期設定の状態から変更ができない。マクロで制御しないボタンは、フォームコントレールで作成していますが、ActiveXでの作成も可能です。
下記をシートオブジェクトに記載し、「シート名を下のリストに取得」ボタンにマクロの登録を行う。
Sub シート名取得_Click()
Dim shtObj As Worksheet
'リストの初期化
ListBox1.Clear
' ブックの全シートを 1 つずつループして処理する
For Each shtObj In ThisWorkbook.Worksheets
'ListBox1にシート名を追加
'自シートは除外(Nameは記述しているシートオブジェクト名)
If Not shtObj.Name = Name Then
'リストボックスにシート名を登録
ListBox1.AddItem shtObj.Name
'選択状態にする(Selected配列は0からスタートする)
ListBox1.Selected(ListBox1.ListCount - 1) = True
End If
Next
End Sub
ポイント：自シート名を直打ち（"実行"等と記述）すると、シート名変更時に影響がでるため、マクロで自シート名を拾ってきている。
実行処理（シート移動処理）を作成する
次に、フォームコントロールのボタンを作成し、右クリック「テキストの編集」で「実行」を設定する。下記のマクロをシートオブジェクトに記載し、マクロの登録を行う。
Sub 実行_Click()
'変数宣言
' ---------------------------
Dim outbook As Workbook
Dim copySheet As Worksheet
Dim FilePathName, newSheetName As String
Dim PathName, filename As String
Dim SelectedSheetName As String
Dim cnt As Long
' ---------------------------
'セルからの入力データ - 既存ブックのファイルパス
FilePathName = Range("B6").Text
' - 新規ブックのフォルダパスと作成するファイル名
PathName = Range("B10").Text
filename = Range("D12").Text
'オプションボタンで既存か新規かを確認
If 既存ブックButton.Value = True Then
'既存ファイルを開く
Set outbook = OpenBook(FilePathName)
Else
'新規ブックを作成して、名前を付けて保存
'以降の処理を共通化するために、新規ファイルを一旦保存
Set outbook = OpenNewBook(PathName & "\" & filename)
End If
'ファイルが問題なく開いた又は作成されたか確認
If Not outbook Is Nothing Then
For cnt = 0 To ListBox1.ListCount - 1
'選択中リストを取得できなかったので、リスト内すべてでループ
If ListBox1.Selected(cnt) Then
'リストで選択中の場合
'シート名を取得
SelectedSheetName = ListBox1.List(cnt, 0)
'シートを移動する
Set copySheet = MoveSheet_BooktoBook(ThisWorkbook, SelectedSheetName, outbook)
If Not copySheet Is Nothing Then
'シート移動成功
Else
'シート移動失敗
MsgBox SelectedSheetName & "シートは、存在しません。最新のシート名を取得しなおして、再度実行してください。"
End If
Else
'移動対象外シートは何もしない
End If
Next cnt '次のリスト内シート名取得ループに戻る
'オブジェクトは使い終わったらメモリを解放
Set copySheet = Nothing
'上書き保存して、閉じる（ブックオブジェクトのメモリ解放）
Call SaveAndCloseBook(outbook)
End If
End Sub
黄色い下線をつけている箇所は、標準モジュールに記載する関数を呼び出している。
下記は、既に別ページで記述したものの流用になるため、そちらを参照してください。
MoveSheet_BooktoBook()については、以前、別ページで出したことがあるのですが、変更を加えています。リネーム処置をなくし、シート削除部分を関数化させています。
'**********************************************************************
' エクセルシートの移動処理（リネームなし）
' (コピー元：inbookのシート名(inSheetName)、
' コピー先：outbookでコピー後シート名(outSheetName)
'
' (inbook)のシート名「inSheetName」をコピーして、削除
' 戻り値：成功時は、コピーしたシートオブジェクト を返す
' 失敗時は、Nothing(空)が返る
'**********************************************************************
Function MoveSheet_BooktoBook(ByVal inbook As Workbook, _
ByVal inSheetName As String, _
ByVal outbook As Workbook) As Worksheet
Set MoveSheet_BooktoBook = CopySheet_BooktoBookEnd(inbook, inSheetName, outbook)
If Not MoveSheet_BooktoBook Is Nothing Then
'コピー成功時は、元シートを削除して移動とする
Call DeleteOneSheet(inbook, inSheetName)
Else
'コピー失敗
Set MoveSheet_BooktoBook = Nothing
End If
End Function
シート移動のマクロは使用せず、コピーに成功したら、元シートを削除する手順としています。シート移動をシートコピーに変更したい場合は、MoveSheet_BooktoBookを呼び出さずに、代わりにCopySheet_BooktoBookEndを呼び出せば、コピーに変更可能です。オプションボタンなどで、ユーザに動作を選択させることも可能で改変しやすくしています。
上記で呼び出されている、CopySheet_BooktoBookEnd()とDeleteOneSheet()を下記に記述します。
'**********************************************************************
' エクセルシートの複製処理（末尾追加）
' (コピー元シート：inWorkbookのシート名(copySheet)、コピー先：outWorkbook)
'
' シート名(copySheet)を outWorkbookの末尾へ複製
' 戻り値：複製されたシートオブジェクト
'**********************************************************************
Function CopySheet_BooktoBookEnd(ByVal inWorkbook As Workbook, _
ByVal copySheet As String, _
ByVal outWorkbook As Workbook) As Worksheet
Dim searchSheet As Worksheet
Dim result As Boolean
Dim rslt As Integer
Dim DelRslt As Boolean
'初期化
DelRslt = True
If Not inWorkbook Is Nothing And Not outWorkbook Is Nothing Then
'コピー元に同じ名前のシート名が存在するか確認
If IsSameSheetName(inWorkbook, copySheet) = True Then
'コピー先に同じ名前のシート名が存在するか確認
If IsSameSheetName(outWorkbook, copySheet) = False Then
'無ければ、そのまま移動可能なので、問題なし。
Else
outWorkbook.Worksheets(copySheet).Activate
rslt = MsgBox("[" & copySheet & "]" & "と同じシート名が既に存在します。差し替えますか？", vbYesNo)
If rslt = vbYes Then
'移動先シートの削除
DelRslt = DeleteOneSheet(outWorkbook, copySheet)
If DelRslt = False Then
'最後の1シートは削除できないので、リネームしておく
outWorkbook.Worksheets(copySheet).Name = "CopySheettoOtherBook2"
End If
Else
'処理中断
MsgBox "処理を中断します。"
Exit Function
End If
End If
'シートを末尾に複製
inWorkbook.Worksheets(copySheet).Copy After:=outWorkbook.Sheets(outWorkbook.Sheets.Count)
If DelRslt = False Then
'移動前に削除できなかった既存同名シートの削除
Call DeleteOneSheet(outWorkbook, "CopySheettoOtherBook2")
End If
'複製されたシートオブジェクトを返す
Set CopySheet_BooktoBookEnd = outWorkbook.ActiveSheet
Else
'指定シート名が存在しない
Set CopySheet_BooktoBookEnd = Nothing
End If
End If
'メモリ解放
Set searchSheet = Nothing
End Function
続けて、DeleteOneSheetも標準モジュールに記述します。CopySheet_BooktoBookEndの解説は、その下に記述します。
'**********************************************************************
' エクセルシートの削除処理
' 第1引数(book)の第2引数(inSheetName)という名前のシートを削除
'
' 戻り値：なし
'**********************************************************************
Function DeleteOneSheet(ByVal book As Workbook, ByVal inSheetName As String) As Boolean
Dim backup_alert As Boolean
If book.Worksheets.Count = 1 Then
'失敗 最後の1シートは削除できません
DeleteOneSheet = False
Exit Function
End If
backup_alert = Application.DisplayAlerts
'削除警告をメッセージを表示させない処置
Application.DisplayAlerts = False
'シート削除
book.Worksheets(inSheetName).Delete
Application.DisplayAlerts = backup_alert
DeleteOneSheet = True '成功
End Function
CopySheet_BooktoBookEndで呼ばれる、下記は、既に別ページで記述したものの流用になるため、そちらを参照してください。
このマクロのメイン部分は、CopySheet_BooktoBookEndになります。シートの追加位置は末尾にしています。末尾にしたのは、シートの並び順を維持するためです。
ポイントは、同名シートが存在した場合に、差し替えを行うのか中断するのか問うメッセージボックスを表示させていますが、差し替えの際に、基本的には既存シートを削除してからシートのコピーを行いたいが、ブック内に1シートしか存在しない場合にシート削除を指示するとエラーが発生するため、一旦削除予定のシートのシート名をリネームし、コピーが完了後に既存シートを削除しています。
エクセルマクロ有効ブックのダウンロード
下記からダウンロードしたエクセルファイルを起動し、コンテンツの有効化を行う。
マクロの有効化手順については、こちらも参考にしてください。