excel – VBA Looping through worksheets to delete blank columns

I created this macro to delete every empty column in active workbook. However it does not work on each sheet and only on an active one.

Please let me know your ideas what can be done to make macro work properly and loop through all the worksheets, not only the active one.

Sub DeleteBlankColumns()

Dim LastColumn As Long
Dim r As Long
Dim Counter As Long
Dim Current As Worksheet

    Application.ScreenUpdating = False
    For Each Current In Worksheets
    LastColumn = Current.UsedRange.Columns.Count + Current.UsedRange.Columns(1).Column - 1
        For r = LastColumn To 1 Step -1
            If Application.WorksheetFunction.CountA(Columns(r)) = 0 Then
                Current.Columns(r).Delete
                Counter = Counter + 1
            End If
        Next r
    Next
    Application.ScreenUpdating = True
    MsgBox "Deleted " & Counter & " empty columns."

End Sub

Option Explicit

Sub DeleteBlankColumns()

Dim LastColumn As Long
Dim r As Long
Dim Counter As Long
Dim Current As Worksheet

    Application.ScreenUpdating = False
    For Each Current In Worksheets
        With Current
            LastColumn = .UsedRange.Columns.Count + .UsedRange.Columns(1).Column - 1
            For r = LastColumn To 1 Step -1
                If Application.WorksheetFunction.CountA(.Columns(r)) = 0 Then
                    .Columns(r).Delete
                    Counter = Counter + 1
                End If
            Next r
        End With
    Next
    Application.ScreenUpdating = True
    MsgBox "Deleted " & Counter & " empty columns."

End Sub

Tags: excelexcel, oop, vba