列Dのセルに名前が見つからない場合は、ワークシートを削除します

Question

私が作業していたworksheet_changeマクロについて質問しました。それはほぼ完了しましたが、今私は困惑しています。ワークブック内のすべてのワークシートをループして、D6：D34のセルにワークシートの名前が見つからない場合は、ワークシートを削除します。どうすればいい？私は完全に困惑している。現在のコード：

Private Sub WorkSheet_Change(ByVal Target As Range) 
Application.ScreenUpdating = False 'Run faster 
Application.DisplayAlerts = False 'Just in case 

'To add worksheets automatically 
Dim shtName As Variant 
For Each shtName In Sheets(1).Range("D6:D34") 
    If shtName <> "" Then 
     If WorksheetExists((shtName)) Then 'do nothing 
     Else 
      ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count) 
      ActiveSheet.Name = shtName 
      Sheets("Admin").Select 
     End If 
    Else 'there's no sheet 
    End If 
Next 

'to delete sheets with no matching value 
Dim ws_count As Integer 
Dim i As Long 

ws_count = ActiveWorkbook.Worksheets.Count 
For i = 1 To ws_count 

'what do I need here??? 

Next i 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
End Sub 

Function WorksheetExists(sName As String) As Boolean 
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)") 
End Function 

Answer 1

Dim ws As Worksheet 

ws_count = ActiveWorkbook.Worksheets.Count 

For i = ws_count To 2 Step -1 
    Set ws = ActiveWorkbook.Worksheets(i) 
    If IsError(Application.Match(ws.Name,Sheets(1).Range("D6:D34"),0)) then 
     Application.DisplayAlerts = False 
     ws.Delete 
     Application.DisplayAlerts = True 
    End If 

Next i