VBAで特定のシート以外を削除する方法

質問

いつもたくさんのお知恵を貸してもらっています。
今回もよろしくお願いいたします。

ブックの構成は下記のとおりです。
Sheet1⇒名簿
Sheet2⇒チームメンバー表
Sheet3⇒営業月報の原版

Sheet3の原版はSheet2のメンバー表をもとにシート名にメンバーの氏名を使ってチームメンバーの分だけ自動で複製（シート名にメンバーの名前を反映）していくようにVBA処理しています。

この処理を終了した後に、上記のSheet1～Sheet3以外の複製したSheetのみをVBAで一括削除する方法はないでしょうか？

教えてください、よろしくお願いします。

回答No.4

Wendy02 · ベストアンサー

こんばんは。

最初に、シートを表す名称について説明しておきます。

1.　シート名(Worksheets("Sheet1") のSheet1 の部分）
2.　シート・インデックス　(Worksheets(i) で、i は、1～シートの数まで）
　　左から右に行くのが、シート・インデックスです。
3.　シート・オブジェクト名(CodeMame)

それで、1は、ユーザー任意で替えられてしまいます。2.は、順序が変わると、インデックスが変わってしまいます。3.は、VBEditor の中で、

左の窓に、「プロジェクト」ウィンドウが出ていたら、そのVBAProject の中を開くと

Sheet1(Sheet1)
Sheet2(Sheet2)
Sheet3(Sheet3)
オブジェクト名（シート名）

となっているはずです。そこで、シート名を変えても、オブジェクト名は変わらないはずです。それを利用するわけです。

>Sheet1：チームのメンバー表
>Sheet2：名簿
>Sheet3：目標金額のベースとなる予算表
>Sheet4：月報の原版

VBEditor の中を確認してみてください。
このオブジェクト名（CodeName) を変更する場合は、プロパティ（通常は、プロジェクト・ウィンドウの下--出ていない場合は、メニューの表示(V)で、プロパティ ウィンドウをクリックしてください）kで、（オブジェクト名）のところを手動で書き換えてあげます。

If Not .Worksheets(i).CodeName Like "Sheet[1-4]" Then
は、たぶん、オブジェクト名との食い違いがあるのだと思います。

お礼

Wendy02さん、こんばんは。
ご丁寧な解説をしていただき、ありがとうございました。

プロパティの修正で解決できました。
綺麗に作成分だけ削除できて非常に使い勝手が向上しました。

本当にありがとうございました。
助かりました。

回答No.3

Wendy02

こんにちは。

少し、イレギュラーな内容だと思います。そのまますんなりとは行きませんね。

>Sheet3の原版はSheet2のメンバー表をもとにシート名にメンバーの氏名を使ってチームメンバーの分だけ自動で複製（シート名にメンバーの名前を反映）していくようにVBA処理しています。

>この処理を終了した後に、

ということですと、シート削除に際し、シート・インデックス番号でとるのは実にあいまいです。シート名は変更されてしまうので、シート名は使えないように思います。この場合はオブジェクト名（CodeName)を使用します。一般的には、Sheet1～Sheet3 という、シート名と同じオブジェクト名になっていますが、オブジェクト名は、通常、マニュアルでしか変更しません。

ここでは、あえて、オブジェクト名はシート名と同じものにさせて処理させていただきます。本来は、一意で名前を変更しておくのがよいかと思います。シート名は変更されても、VBAでは、そのまま使用できます。使用前には、必ず、シートプロパティを確認しておくほうがよいです。オブジェクト名は、シート名とは必ずしも同じではありません。

なお、仕事で使う場合は、必ずダイアログで、ユーザーに確認を取るように作ります。また、該当しない場合は、マクロは抜けるように作ります。

標準モジュールのみ
'-------------------------------------------------

Sub Test1()
　　Dim i As Integer
　　Dim flg As Boolean
　　flg = True
　　With ActiveWorkbook
　　　　For i = 1 To .Worksheets.Count
　　　　　　If Not .Worksheets(i).CodeName Like "Sheet[1-3]" Then
　　　　　　　　.Worksheets(i).Select flg
　　　　　　　　flg = False
　　　　　　End If
　　　　Next i
　　　　If flg Then
　　　　　 MsgBox "該当するシートが見当たりません。", vbInformation
　　　　　　　.Worksheets("Sheet1").Select
　　　　　 Exit Sub
　　　　End If
　　　　If MsgBox("選択されたシートを削除します。よろしいですか？", vbOKCancel) = vbCancel Then
　　　　　 .Worksheets("Sheet1").Select
　　　　　 Exit Sub
　　　　End If
　　　　Application.DisplayAlerts = False
　　　　　ActiveWindow.SelectedSheets.Delete
　　　　Application.DisplayAlerts = True
　　　　.Worksheets("Sheet1").Select
　　End With
End Sub

お礼

ありがとうございます。
>ということですと、シート削除に際し、シート・インデックス番号でとるのは実にあいまいです。シート名は変更されてしまうので、シート名は使えないように思います。この場合はオブジェクト名（CodeName)を使用します。一般的には、Sheet1～Sheet3 という、シート名と同じオブジェクト名になっていますが、オブジェクト名は、通常、マニュアルでしか変更しません。

>ここでは、あえて、オブジェクト名はシート名と同じものにさせて処理させていただきます。本来は、一意で名前を変更しておくのがよいかと思います。シート名は変更されても、VBAでは、そのまま使用できます。使用前には、必ず、シートプロパティを確認しておくほうがよいです。オブジェクト名は、シート名とは必ずしも同じではありません。

すいません、理解しきれませんでした。

実はSheet1～3以外に新たに4枚目を追加しました。
内容は営業月報の目標金額のベースとなる予算表です。
番号順にいくと、
Sheet1：チームのメンバー表
Sheet2：名簿
Sheet3：目標金額のベースとなる予算表
Sheet4：月報の原版
という構成になっております。

記載の通りにVBEにコピーして、If Not .Worksheets(i).CodeName Like "Sheet[1-3]" Then　の部分は"Sheet[1-4]" に変更して実行したのですが、Sheet4まで消えてしまいます。（月報の原版）

ダイヤログの表示等は非常にありがたい機能なので、使わせていただきたいのですが、Sheet1から4まで残して削除するにはどのようにすればできるでしょうか？

私が理解しきれず、すいません。

回答No.2

hotosys

こんなのでは？
Sub sample()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case "Sheet1", "Sheet2", "Sheet3"
Case Else
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End Select
Next
End Sub

お礼

ありがとうございました！

回答No.1

koharu-chan

こんばんは。こんな感じでいかがでしょう？

Dim i As Long
Dim DeleteSheet() As String

ReDim DeleteSheet(0)
For i = 1 To Application.Worksheets.Count
If Worksheets(i).Name = "Sheet1" Or _
Worksheets(i).Name = "Sheet2" Or _
Worksheets(i).Name = "Sheet3" Then
Else
ReDim Preserve DeleteSheet(UBound(DeleteSheet) + 1)
DeleteSheet(UBound(DeleteSheet)) = Worksheets(i).Name
End If
Next

Application.DisplayAlerts = False
For i = 1 To UBound(DeleteSheet)
Worksheets(DeleteSheet(i)).Delete
Next
Application.DisplayAlerts = True

お礼

遅くなって失礼しました。
削除に成功しました。

参考にさせていただきます。ありがとうございました。