حذف کلیه شیت های خالی در اکسل

[~M*E*H*D*I~]

با درود

با استفاده از کد زیر قادر خواهید بود شیت های خالی که حاوی اطلاعاتی نیستند با یک کلیک حذف کنید

Sub DeleteEmptyWorkSheets()
Dim ws As Worksheet 
Dim deletedsheetcount As Long 
Dim strMessage As String
Application.DisplayAlerts = False
 For Each ws In ActiveWorkbook.Worksheets 
If Application.CountA(ws.Cells) = 0 Then
 ws.Delete
 deletedsheetcount = deletedsheetcount + 1 
Else strMessage = strMessage & ws.Name & vbLf 
End If 
Next
 Application.DisplayAlerts = True
MsgBox deletedsheetcount & " empty sheets deleted" & vbLf &"Remaining sheets: " & vbLf & strMessage
End Sub