VBAを使用して指定された名前のセットまですべてのシートを削除

Question

{A2、A3、...}のリストと名前サマリーのシートを除いて、現在のブック内のすべてのシートを削除します。 私は、次のコード

Dim MyCell As Range, MyRange As Range 


    Set MyRange = Sheets("Summary").Range("A2") 
    Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

    Set wbook = ActiveWorkbook 
    For Each xWs In wbook.Worksheets 
    For Each MyCell In MyRange 
     If xWs.Name <> MyCell.Value And xWs.Name <> "Summary" Then 
      xWs.Delete 
     End If 
    Next MyCell 
Next 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 

を書いたが、私はそれが何であるかわからない、実行時エラーが表示されます。 その後、私は行ずつ実行してみました：「xWs.Name =概要」を超える最初のループでは何の問題は、私はこのコードがあることを知っている私は

If xWs.Name <> MyCell.Value And xWs.Name <> "Summary" Then 

でエラーを取得する第二のシートのために最初は存在しません名前が一致しても名前の集合まで実行されているので、効率的ではありません。しかし、私は効率的な方法でVBAのトウセットをどのように比較できるか分かりませんでした。 では、A列の名前のリストを見ることができます。

Answer 1

少し違うので、このシートを削除しないようにフラグを立てる必要がある場合は、すべてのシートの範囲をループする必要があります。 以下のコードを試してみてください。

Sub DeleteSelectedSheets() 

Dim MyCell As Range, MyRange As Range 
Dim wbook As Workbook, xWs As Worksheet 
Dim DeleteSheetFlag As Boolean 

Set MyRange = Sheets("Summary").Range("A2") 
Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Set wbook = ActiveWorkbook 

For Each xWs In wbook.Worksheets 
    DeleteSheetFlag = True 

    For Each MyCell In MyRange 
     Select Case xWs.Name 

      Case MyCell.Value, "Summary" 
       DeleteSheetFlag = False 
       Exit For 

     End Select 

    Next MyCell 

    If DeleteSheetFlag Then 
     xWs.Delete 
    End If 

Next xWs 

Application.DisplayAlerts = True 
Application.ScreenUpdating = True 

End Sub