別ファイルへシートコピー後、シート名変更をして保存する | エクセルマクロ(VBA)実践蔵(じっせんぐら)

トップ項目一覧

このページに記載しているマクロは、1シートを別ブックへシート名を変更してコピーして保存するマクロになります。

複数シートをシート名変更せずに別ブックへまとめて保存するマクロを記述しているページもありますので、以下は参考までに。

• 関連ページの紹介
• 複数シートをまとめて別ブックへ移動して保存するマクロ

テンプレートを活用する場合に必ず必要となる処理が、別ファイルへのシートの複製とシート名のリネーム処理になります。マクロ有効ファイル(xlsm)にあるシートを標準エクセルファイル(.xlsx)へコピーし、シート名をリネームすることを考えます。よく使用するマクロは準備しておくと、いつでも使いまわせます。

入力データ同様、出力ファイル先の指定でも、ファイル参照、又は、フォルダ参照を使用した方が汎用性が高くなります。

ここではテンプレートシートを複製する前提のため、コピー元シートを(シート名「temp」)に限定しています。

シートを複製する場合、新規エクセルファイル 又は 既存エクセルファイル に対して、シートを複製することになると思います。

新規エクセルファイルの場合は、格納先フォルダを「フォルダ参照」で指定し、ファイル名をセルから指定できるようにします。

既存エクセルファイルの場合は、「ファイル参照」を使用し、既存のエクセルファイルを選択できるようにします。

C列17行目をクリックすると、下記のように入力規則のリストにしています。

セルの入力規則を設定するダイアログ

入力規則のリストによって選択肢を限定することで、異常値が設定されることへの考慮を行う必要はなくなります。

テンプレートシートを複製した後のシート名は、マクロを実行する日の日付(月2桁と日2桁の4桁)にしています。上の図の"F列19行目"のセルは、手入力ではなく、エクセルの標準関数 「=TODAY()」をセルに記入してあります。そして、セルの書式設定でユーザー設定(mmdd)を設定しておくと、図のように4桁で表示されます。これをマクロ側で取得するには、「Range("F19").Text」にて取得できます。「.Value」ではなく「.Text」で取得することがポイントです。セルの書式設定をマクロ側にも引き継げます。

シート側の処理

既存ファイル指定ボタンに登録するマクロについては、ファイル参照 - ファイル選択ダイアログを、新規ブックを作成する場合のフォルダ参照ボタンに登録するマクロについては、フォルダ参照 - フォルダ選択ダイアログを参照してください。

 
'********************************** 
' 実行ボタンに登録されているマクロ 
'********************************** 
Sub 実行_Click() 
     
    '変数宣言(オブジェクト) 
    Dim outBook As Workbook 
    Dim copySheet As Worksheet 
         
    '変数宣言(文字列) 
    Dim FilePathName As String, newSheetName As String 
    Dim PathName As String, filename  As String 
     
    ' --------------------------- 
    'セルからの入力データ 
    ' - 既存ブックに追加する場合用 
    FilePathName = Range("B6").Text 
     
    ' - 新規ブックに追加する場合用 
    PathName = Range("B10").Text 
    filename = Range("D12").Text 
     
    ' - 共通 
    newSheetName = Range("F19").Text 
    ' --------------------------- 
     
    '------画面更新OFF------------------ 
    Application.ScreenUpdating = False 
    '------------------------------------ 
     
    If StrComp(Range("C17").Value, "既存エクセルファイル") = 0 Then 
     
        '既存ファイルを開く 
        Set outBook = OpenBook(FilePathName) 
         
    Else 
     
        '新規ブックを作成して、名前を付けて保存 
        Set outBook = OpenNewBook(PathName & "\" & filename) 
                 
    End If 
     
    If Not outBook Is Nothing Then 
     
        'ブックへ"temp"シートを複製し、作成されたオブジェクトをもらう 
        Set copySheet = CopySheet_BooktoBook(ThisWorkbook, "temp", outbook, newSheetName) 
            
        '**************************** 
        '* 新規シートへデータを入力 * 
        '**************************** 
         
        'オブジェクトは使い終わったらメモリを解放 
        Set copySheet = Nothing 
         
        '上書き保存して、閉じる（ブックオブジェクトのメモリ解放） 
        Call SaveAndCloseBook(outBook) 
         
    End If 
     
    '------画面更新ON------------------ 
    Application.ScreenUpdating = True 
    '------------------------------------ 
 
End Sub 
 

上記で呼び出しているOpenBook、OpenNewBook、CopySheet_BooktoBook、SaveAndCloseBookは、標準モジュールに記載していきます。

Application.ScreenUpdating にFalseを設定すると、エクセルの既存ファイルや新規ファイルを開いたり閉じたりする動作が画面上、表示されなくなります。使用する場合は、必ずマクロ終了前にTrueに戻します。動作を確認したい場合は、デフォルトのTrueのまま動作させてください。処理量が多いマクロを実行する際には、画面更新をOFFにすることで処理速度は向上します。

標準モジュール側の処理

 
'*************************** 
' エクセルファイルを開く 
'*************************** 
Function OpenBook(ByVal FilePath As String) As Workbook 
     
    On Error Resume Next 
     
    Set OpenBook = Workbooks.Open(FilePath) 
     
    'エラーが発生した事を確認する 
    If Err.Number <> 0 Then 
        MsgBox ("エクセルファイルを開けませんでした。") 
        Set OpenBook = Nothing 
    End If 
     
End Function 

エラー処理を念のため、入れていますが、ファイルを参照後に、ユーザがファイルを削除しない限りは、エラールートには入りません。

 
'**************************************************************** 
' 新規ファイルを作成して開く。空の状態で一度保存。 
'   同一ファイル名が既に存在する場合、 
'    ①前のファイルを破棄して新規作成したものを置き換えるか、(SaveAs関数内動作) 
'    ②既存ファイルを開きなおすか、③処理をキャンセルするか選択できます。 
' 
' 新規作成して保存したWorkbookオブジェクト　又は 
' 既存の同一ファイル名を開きなおしたWorkbookオブジェクトを返す 
'**************************************************************** 
Function OpenNewBook(ByVal SaveFilePath As String) As Workbook 
     
    Dim newBook As Workbook 
    Dim kekka As VbMsgBoxResult 
     
    '新規ファイルを開く 
    Set newBook = Workbooks.Add '新規ワークブックを作成 
     
     
    On Error Resume Next 
     
    '新規ブックの保存 
    newBook.SaveAs SaveFilePath 
     
    If Err.Number <> 0 Then 
                 
        '保存しないで閉じる 
        newBook.Close SaveChanges:=False 
         
        kekka = MsgBox("既存ファイルに追加しますか？", vbYesNo + vbQuestion) 
         
        If kekka = vbYes Then 
         
            '既存ブック優先が選択された場合、既存ブックを開く 
            Set newBook = OpenBook(SaveFilePath) 
        Else 
             
            '処理終了 
            MsgBox "ファイル名を変更して、再実行してください。" 
             
            Set newBook = Nothing 
             
        End If 
    End If 
     
    'Workbookオブジェクトを返す 
    Set OpenNewBook = newBook 
 
End Function 
 

新規ブックを開き、名前を付けて保存する際に、既に同じファイル名が同じフォルダ上に存在する場合、置き換えるか、置き換えを行わないかの選択ダイアログが表示されます。これは、マクロで制御しているものではなく、エクセルのExcelBook ObjectのSaveAs関数の中に組み込まれています。このとき、「はい」を選択した場合は、エラーにはならず、正常（同じファイル名が同じフォルダ上に存在しないとき）と同様の扱いになります。

上記ダイアログで「いいえ」（置き換えない）を選択した場合は、SaveAs関数からエラーが通知されます。置き換えない場合が選択された時の上記マクロでの処理は、

• 新規のエクセルファイルを保存せずに閉じる
• 同一名の既存ファイルを更新するか確認するダイアログを表示する
• (A)既存ファイルを更新することをユーザが選択した場合、既存ファイルを開く
• (B)既存ファイルを開かないをユーザが選択した場合、「ファイル名を変更して再実行してください」というメッセージを表示して処理を終了する

というコードになります。

続いては、シート側の「実行ボタン」クリック時のイベント関数から呼び出されている、エクセルシートをコピーする関数の処理になります。

 
'********************************************************************** 
' エクセルシートの複製処理 
'   (コピー元シート：inWorkbook、コピー先：outWorkbook) 
' 
'    第一引数(inWorkbook)ファイル内の第二引数(copySheet)シート名を  
'    第三引数(outWorkbook)の先頭へ複製 
'    第四引数(outSheetname)はオプションでコピー後のシート名。 
'    戻り値：複製されたシートオブジェクト 
'********************************************************************** 
Function CopySheet_BooktoBook(ByVal inWorkbook As Workbook, _ 
                              ByVal copySheet As String, _ 
                              ByVal outWorkbook As Workbook, _ 
                              Optional ByVal outSheetName As String = "") As Worksheet 
                                 
    Dim searchSheet As Worksheet 
    Dim result As Boolean 
     
    If Not inWorkbook Is Nothing And Not outWorkbook Is Nothing Then 
     
        If Not inWorkbook.Worksheets(copySheet) Is Nothing Then 
         
            'シートを複製 
            inWorkbook.Worksheets(copySheet).Copy Before:=outWorkbook.Sheets(1) 
                         
            If Not outSheetName = "" Then 
            'オプションでリネーム指示あり 
                 
                '同一シート名が存在するか確認 
                result = IsSameSheetName(outWorkbook, outSheetName) 
                 
                If result = False Then 
                '変更したいシート名と同一シート名がない場合、リネームする 
                     
                    '複製シートに指定の名前を付ける 
                    outWorkbook.ActiveSheet.Name = outSheetName 
                Else 
                     
                End If 
            End If 
            '複製されたシートオブジェクトを返す 
            Set CopySheet_BooktoBook = outWorkbook.ActiveSheet 
         
        End If 
     
    End If 
     
    'メモリ解放 
    Set searchSheet = Nothing 
 
End Function 
 

 
'********************************************************************** 
' エクセルブック内に同一シート名が存在するかを返す 
'    第一引数：エクセルブック(Workbook)、第二引数：シート名(String) 
'    戻り値：TRUE(同一シート名あり) 
'            FALSE(同一シート名なし) 
'********************************************************************** 
Function IsSameSheetName(book As Workbook, chkSheetName As String) As Boolean 
     
    Dim targetSheet As Worksheet 
     
    '戻り値を同一シート名なしで初期化 
    IsSameSheetName = False 
     
    '引数のブック内のシート数分確認 
    For Each targetSheet In book.Worksheets 
                
        If Not chkSheetName = "" Then 
             
            'シート名を比較 
            If StrComp(chkSheetName, targetSheet.Name, vbTextCompare) = 0 Then 
                 
                '同一シート名ありを設定 
               IsSameSheetName = True 
               Exit For 
             
            End If 
        Else 
            'チェックなし 
            Exit For 
        End If 
    Next 
     
    'メモリの解放 
    Set targetSheet = Nothing 
     
End Function 

コピー後にオプション引数で指定された「シート名」と同一シート名が既に存在する場合は、シートコピー関数がコピーしたときの初期シート名のままとなります。

上記関数の後に、シート側の「実行ボタン」クリック時のイベント関数に戻り、下記の関数が呼び出され、更新したエクセルファイルを保存して閉じます。

 
'************************************ 
' エクセルブックを上書きして、閉じる 
'************************************ 
Function SaveAndCloseBook(ByRef objWorkbook As Workbook) 
     
    'ブックを上書き保存 
    objWorkbook.Save 
     
    'ブックを閉じる 
    objWorkbook.Close 
     
    'メモリ解放 
    Set objWorkbook = Nothing 
     
End Function 
 

用済みとなったメモリを忘れずに解放しておきます。

エクセルVBAでは、Object型(構造体)を操作するときには、「Set 変数名 = Object名 」にて、設定し、使用が終わったら、Nothing を設定して、メモリを解放します。

引数がByRefの場合は、呼び出し側と同一のメモリ領域を使用します。ByValの場合は、関数内限定のメモリ領域が使用され、関数終了時に自動解放となります。

ここでは、呼び出し側のメモリを解放するために、ByRefとしています。

別ファイルへシート複製するエクセルマクロ有効ブックのダウンロード

ダウンロードしたエクセルファイルを起動し、コンテンツの有効化を行う。

マクロの有効化手順については、こちらも参考にしてください。

別ファイルへシート複製するエクセルファイル(xlsm)のダウンロード

ポイント ☆ point ☆

既存ファイルへのシート追加と新規ファイルへのシート追加の処理を共通化していくために、新規ファイルを作成後、すぐに名前を付けて保存することで、以降の処理が既存ファイルへのシート追加と共通化することができました。但し、欠点としては、途中でエラーが発生した場合は、空ファイルが残ります。今回は、再度実行する前提で記述しています。