delete an empty sheets

hello
the following macro delete empty sheets .is it possible to get a count of how many sheets where deleted,and maybe a list of there names on a msgbox.
[VBA]
Sub DelWS()
Application.DisplayAlerts = False
Dim Sh As Worksheet
For Each Sh In ActiveWorkbook.Worksheets
If Application.WorksheetFunction.CountA(Sh.Cells) = 0 Then
If Worksheets.Count > 1 Then
Sh.Delete
End If
End If
Next
Application.DisplayAlerts = True
End Sub

[/VBA]
thanks

[VBA]
Sub DelWS()
Application.DisplayAlerts = False
Dim Sh As Worksheet ,counter as integer,shtString as String
Counter = 0
shtString = ""
For Each Sh In ActiveWorkbook.Worksheets
If Application.WorksheetFunction.CountA(Sh.Cells) = 0 Then
If Worksheets.Count > 1 Then
counter = counter + 1
shtString = shtString & "," sh.Name
Sh.Delete
End If
End If
Next
Application.DisplayAlerts = True
MsgBox Counter & " Sheets Deleted" & vbNewLine & _
"Names: " & shtString
End Sub
[/VBA]