Excel

すべてのシートを指定した場所に別ブックに保存する

2021-03-12

エクセルのブックにあるすべてのシートをそれぞれ別のブックに保存する方法です。

全てのシートを別ブックで保存する
別ブックで保存

最小限の変数のVBA(マクロ)例

  • ブックの保存先:F:¥sample

エラー処理等何もしていない例です。

Sub sample()
    Dim i As Long
    Dim wsName As String
    Dim wbName As String
    
    For i = 1 To Sheets.Count
        wsName = Worksheets(i).Name
        wbName = "F:\sample" & "\" & wsName
        
        Sheets(wsName).Copy
            With ActiveWorkbook
                .SaveAs Filename:=wbName
                .Close
            End With
    Next i
End Sub

変数

変数は2~3行目

1行目:Dim i As Long → シートのカウント

シート

2行目:Dim wsName As String → シートの名前

3行目:Dim wbName As String → ブック保存する名前

処理:全てのシート

6行目と15行目

For i = 1 To Sheets.Count

 処理

Next i

シート1~シートの数のみ処理をします。

処理:ブック保存

7行目~14行目

  • 7行目:変数「wsName」にワークシートの名前を格納します。
  • 8行目:変数「wbName」にブック保存するパスとブック名を格納します。
  • 10行目:シートをコピーします。
  • 12行目:シートを別名保存し名前を付けます。
  • 13行目:ブックを閉じます。

参考:画面更新制御と終了メッセージを追加

別名保存するブックが多い場合は、画面に更新が表示され処理スピードが落ちます。処理中に画面更新を停止するコードを追記します。

Sub sample()
    Dim i As Long
    Dim wsName As String
    Dim wbName As String
    
    Application.ScreenUpdating = False
    
    For i = 1 To Sheets.Count
        wsName = Worksheets(i).Name
        wbName = "F:\sample" & "\" & wsName
        
        Sheets(wsName).Copy
            With ActiveWorkbook
                .SaveAs Filename:=wbName
                .Close
            End With
    Next i
    Application.ScreenUpdating = True
    MsgBox "ブックの保存をしました。"
    
End Sub

6行目、18行目、19行目に追記しました。

-Excel
-

© 2021 オフィスのQ&A