【マクロ・VBA】複数シートを名前を付けて保存する

VBA

2023.03.18

複数シートを名前を付けて保存

Part１

Sub 複数シートを名前をつけて保存()
            
ReDim A(1 To 2) As Variant
A(1) = "TEST1"
A(2) = "TEST2"
            
ThisWorkbook.Worksheets(A).Copy
    
A = ThisWorkbook.path & "\" & "保存_" & VBA.Format(Now, "yyyymmdd " & "hh-mm-ss")
ActiveWorkbook.SaveAs FileName:=A
    
Application.CutCopyMode = False
ActiveWorkbook.Close
MsgBox "完了"
End Sub

Part２

Sub 複数シート名前を付けて保存()

    Dim filePath As String
    Dim fileName As String
    Dim sheetName As String
    Dim password As String
    
    ' ファイル保存先の指定
    filePath = ThisWorkbook.Path & "\"
    
    ' ファイル名の指定
    fileName = "保存_" & Format(Now, "yyyymmdd_hh-mm-ss") & ".xlsx"
    
    ' パスワードの設定
    password = "mypassword"
    
    ' シートをループして保存
    For Each sht In ThisWorkbook.Sheets
        sheetName = sht.Name
        sht.Copy
        ActiveWorkbook.SaveAs Filename:=filePath & sheetName & "_" & fileName, FileFormat:=xlOpenXMLWorkbook, Password:=password
        ActiveWorkbook.Close savechanges:=False
    Next sht
    
    MsgBox "保存しました。"
    
End Sub

この例では、For Eachループを使用して、ワークブック内のすべてのシートをループし、各シートを名前をつけて保存しています。Copyメソッドを使用して、シートを新しいワークブックにコピーしてから、SaveAsメソッドで名前をつけて保存しています。各シートに対して、異なる名前を指定するために、ファイル名にシート名を含めています。また、保存するファイルの形式は、Excel Workbook（.xlsx）を指定しています。