【VBA】特定のシートを新規ブックとして保存する方法

1Sub 特定のシートに名前をつけてブックとして保存()
2
3    Dim TargetBookName As String
4    Dim TargetBookPath As String
5    Dim TargetSheetName As String
6    Dim OutputFileName As String
7    Dim OutputFolder As String
8    
9    Dim Wb1 As Workbook
10    Dim Wb2 As Workbook
11    Set Wb1 = ThisWorkbook
12    
13    '保存元のExcelとシート名を定義
14    TargetBookPath = Wb1.Path
15    TargetBookName = "保存元のExcel"
16    TargetSheetName = "保存したいシート名"
17    
18    '保存先フォルダ名と出力ファイル名を定義
19    OutputFolder = Format(Now(), "yyyyMMdd") & "_" & Format(Now(), "HHmmss")
20    OutputFileName = "出力するExcelファイル名"
21    MkDir TargetBookPath & "\" & OutputFolder
22    
23    '保存元のExcelを開く
24    Workbooks.Open TargetBookPath & "\" & TargetBookName & ".xlsx"
25    Set Wb2 = Workbooks(TargetBookName & ".xlsx")
26    
27    '保存したいシート以外のシートをすべて削除
28    Application.DisplayAlerts = False
29    With Wb2
30        Dim i As Long
31        For i = .Sheets.Count To 1 Step -1
32            If .Sheets(i).Name <> TargetSheetName Then
33                .Sheets(i).Delete
34            End If
35        Next i
36    End With
37        
38    '名前をつけて保存
39    Wb2.SaveAs Filename:=TargetBookPath & "\" & OutputFolder & "\" & OutputFileName & ".xlsx"
40    Wb2.Close
41    
42    'メモリを解放
43    Set Wb1 = Nothing
44    Set Wb2 = Nothing
45
46End Sub
47