Delete all empty sheets in Excel

Sub CleanEmptySheets()
    Dim ws As Worksheet
    Dim DelSheet As Integer
    Dim Ans As Integer
    Application.DisplayAlerts = False
    DelSheet = 0
    For Each ws In ActiveWorkbook.Worksheets
        If Application.CountA(ws.Cells) = 0 And Sheets.Count > 1 Then
            Ans = MsgBox("Are you sure to delete the sheet" & ws.Name & " ?", vbYesNo)
            Select Case Ans
                Case vbYes
                    ws.Delete
                Case vbNo
                    MsgBox "Running this software needs to first remove all empty sheets!" _
                    & vbNewLine & vbNewLine & _
                    "If you want to keep a sheet, fill in anything in it. " _
                    & vbNewLine & vbNewLine & _
                    "The code will stop running..."
                    End
            End Select
        End If
    Next ws
    Application.DisplayAlerts = True
End Sub
Subject
Category
Coding language