エクセルのマクロについて教えてください。

マクロを実行して２つのファイルの内、マクロ有効「.xlsm」形式のファイルに指定シートを残し
一般「.xlsx」にはシートを削除出来る方法を教えてください。
マクロ
Sub 電子提出()
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(Array("記載方法")).Delete
Worksheets(Array("提出図書（参考）")).Delete
Worksheets(Array("Web申請手順（参考）")).Delete
Worksheets(Array("申請種別")).Delete
Worksheets("提出シート").Activate
Dim rng As Range
Set rng = Selection.Cells
Range("B1", "H47").Select
myBook = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook
rng.Select
Worksheets(Array("消防の指摘一覧（参考資料）")).Delete
Sheets("提出シート").Range("D3,D4,D7").ClearContents
Range("D7").Select
ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value, FileFormat:=xlOpenXMLWorkbookMacroEnabled

Application.Quit
With ThisWorkbook
.Saved = True
Application.DisplayAlerts = True
.Close False
End With
Sheets("提出シート").Shapes("新築FD").Visible = False '
Sheets("提出シート").Shapes("計変FD").Visible = False '
Sheets("提出シート").Shapes("増築FD").Visible = False '
Sheets("提出シート").Shapes("担当者").Visible = False '
Range("D7").Select

End Sub
が有ります。
マクロを実行すると不要シートを削除して、指定セル値をファイル名で、マクロ有効「.xlsm」
と一般「.xlsx」の２つのファイルを作成出来ます。
マクロを実行した時に
シート名「消防の指摘一覧（参考資料）をマクロ有効「.xlsm」のファイルのみ残したいのですが、
今のマクロコードだと逆の一般「.xlsx」にシートが残り、マクロ有効「.xlsm」のファイルではシートが削除されてしまします。
シート名「消防の指摘一覧（参考資料）をマクロ有効「.xlsm」のファイルのみ残す方法を教えてください。よろしくお願いいたします。

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2023/03/12 11:50

こんにちは

何度か同じような条件変更でご質問を繰り返しているようですが
処理手順、考え方を変えると容易です

現在）　基ブックを加工（不要シート削除）して保存でなく
変更）　基ブックの必要シートをコピー　新規ブックを作成　
下記の様にすることで対象を出力ブックに限定する事が出来、追加加工も容易になります

昨日ご質問されていた内容で作成したものです
投稿時、削除？されていたのか投稿できませんでした

コード内にコメントを入れましたので　ロジックを確認してみてください
＊シート名を明示している為　エラー処理を加えてください

Sub Sample()
Dim mybook As Workbook
Set mybook = ActiveWorkbook
mybook.Worksheets("提出シート").Activate
'要らないシート名を列挙
Const strName As String = "記載方法,提出図書（参考）,Web申請手順（参考）,申請種別"
Dim strCopysht As Variant
Dim sht As Worksheet
Dim availabilityKey As String
availabilityKey = Worksheets("提出シート").Range("D12").Value
Dim fName As String
fName = mybook.Worksheets("提出シート").Range("P1").Value

Dim tmp As String
'出力シート名作成
For Each sht In mybook.Worksheets
If Not InStr(strName, sht.Name) > 0 Then
tmp = tmp & sht.Name & ","
End If
Next
tmp = Left(tmp, Len(tmp) - 1)
strCopysht = Split(tmp, ",") '出力シート名を配列へ

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'.xlsx-------------
mybook.Sheets(strCopysht).Copy
With ActiveWorkbook
'加工
.Worksheets("消防の指摘一覧（参考資料）").Delete
.Worksheets("提出シート").Range("B1", "H47").Select
'名前を付けて保存 .xlsx 51
.SaveAs Filename:=mybook.Path & "\" & fName & "(提出用).xlsx", FileFormat:=51
.Close
End With

'.xlsm----------------
mybook.Activate
mybook.Sheets(strCopysht).Copy
With ActiveWorkbook
'加工
If availabilityKey <> "有" Then
.Worksheets("消防の指摘一覧（参考資料）").Delete
End If
With .Worksheets("提出シート")
.Activate
.Range("D3,D4,D7").ClearContents
.Range("D7").Select
End With
'名前を付けて保存.xlsm 52
.SaveAs Filename:=mybook.Path & "\" & fName & ".xlsm", FileFormat:=52
.Close
End With

mybook.Activate
'--下から（保存しないで閉じるので不要）
'ThisWorkbook閉じる前の設定
'With Worksheets("提出シート")
'.Activate
'.Shapes("新築FD").Visible = False '
'.Shapes("計変FD").Visible = False '
'.Shapes("増築FD").Visible = False '
'.Shapes("担当者").Visible = False '
'.Range("D7").Select
'End With
'--まで（保存しないで閉じるので不要）

Application.ScreenUpdating = True
Application.DisplayAlerts = True
'ThisWorkbook保存しないで閉じる
If Workbooks.Count = 1 Then Application.Quit
mybook.Close saveChanges:=False

End Sub

この回答へのお礼

回答ありがとうございます。
昨日、質問を閉じてしまい申し分け有りませんでした。
全て上手く出来ました。
いつも助けて頂きまして
ありがとう御座います。

お礼日時：2023/03/12 12:12

No.1 回答者： 河内のおやじ 回答日時： 2023/03/12 10:21

以下は、マクロコードを変更して、指定シートをマクロ有効「.xlsm」形式のファイルに残し、一般「.xlsx」形式のファイルからは削除する方法です。

Sub 電子提出()
Application.DisplayAlerts = False
On Error Resume Next
'一般「.xlsx」形式のファイルからシートを削除
ThisWorkbook.Worksheets(Array("記載方法", "提出図書（参考）", "Web申請手順（参考）", "申請種別")).Delete
ThisWorkbook.Worksheets(Array("消防の指摘一覧（参考資料）")).Visible = False
ThisWorkbook.Worksheets("提出シート").Activate
Dim rng As Range
Set rng = Selection.Cells
Range("B1", "H47").Select
myBook = ThisWorkbook.Path
'一般「.xlsx」形式のファイルを保存
ActiveWorkbook.SaveAs Filename:=myBook & "" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook
rng.Select
'マクロ有効「.xlsm」形式のファイルからシートを削除
ThisWorkbook.Worksheets(Array("記載方法", "提出図書（参考）", "Web申請手順（参考）", "申請種別", "提出シート")).Delete
ThisWorkbook.Worksheets(Array("消防の指摘一覧（参考資料）")).Visible = True
'指定セル値をファイル名にしてマクロ有効「.xlsm」形式のファイルを保存
ActiveWorkbook.SaveAs Filename:=myBook & "" & Range("P1").Value & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.Quit
With ThisWorkbook
.Saved = True
Application.DisplayAlerts = True
.Close False
End With
End Sub

変更点は、以下の通りです。

マクロ有効「.xlsm」形式のファイルに残すシートを削除する部分を、マクロ有効「.xlsm」形式のファイルからシートを削除する部分に変更し、消防の指摘一覧（参考資料）シートを非表示にする部分を追加しました。
一般「.xlsx」形式のファイルからシートを削除する部分に、提出シートを削除する処理を追加しました。
マクロ有効「.xlsm」形式のファイルを保存する部分に、ファイル名に".xlsm"を追加しました。