Удалить несколько листов Excel в VBA

Question

Я использую книгу Excel для программной генерации.Как только рабочая книга создана, на нескольких листах есть необходимые данные, и на некоторых из них нет бланков только с шаблонами по умолчанию.

Мне нужно удалить все листы с шаблонами по умолчанию (значит, нет данных).Я могу проверить конкретную ячейку, чтобы определить это, однако мне нужно знать, как проверить все листы, а затем удалять листы по одному.

У меня есть этот фрагмент кода:

Sub TestCellA1()
  'Test if the value is cell D22 is blank/empty
  If IsEmpty(Range("D22").Value) = True Then
    MsgBox "Cell A1 is empty"
  End If
End Sub

Answer 1

Альтернативная реализация, использующая For-Each:

Sub deleteSheets()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = Workbooks("Name of your Workbook")
'Set wb = ThisWorkbook   You can use this if the code is in the workbook you want to work with
Application.DisplayAlerts = False 'skip the warning message, the sheets will be deleted without confirmation by the user.
For Each sht In wb.Worksheets
    If IsEmpty(sht.Range("D22"))  And wb.Worksheets.Count > 1 then
        sht.Delete
    End If
Next sht
Application.DisplayAlerts = True
End Sub

Это в основном служит демонстрацией того, как вы можете легко просматривать рабочие листы.

Как предложено в комментариях ниже @Darren Bartrup-Cook, логика, согласно которой удаляются листы, может и должна быть изменена, чтобы не только соответствовать вашим целям, но и включать меры предосторожности.

Убедиться, что в рабочей книге всегда есть хотя бы один лист, является одним из них. Это может быть обеспечено множеством способов. Я обновил свой ответ, чтобы реализовать один из них.

Answer 2

Попробуйте это:

Sub DeleteEmptySheets()
    Dim i As Long, ws As Worksheet
    ' we don't want alerts about confirmation of deleting of worksheet
    Application.DisplayAlerts = False
    For i = Worksheets.Count To 1 Step -1
        Set ws = Worksheets(i)
        ' check if cell D22 is empty
        If IsEmpty(ws.Range("D22")) Then
            Sheets(i).Delete
        End If
    Next
    ' turn alerts back on
    Application.DisplayAlerts = True
End Sub