For all active sheets in a workbook

I have a VB script to autofit merged cells height, but it only works for the first sheet/current sheet of the workbook.

The VBA Script is originally from Autofit Merged Cells with VBA, and I made some slightly range change.

I'd like to make all my available/active sheets to run this same VB script. So, I added the following SlectedSheets code to the AutofixMergedCellHeigh VB script, but it didn't work.

Does anyone could help out? Thanks a lot!

AutofixMergedCellHeight:

Sub FixMerged()
    Dim mw As Single
    Dim cM As Range
    Dim rng As Range
    Dim cw As Double
    Dim rwht As Double
    Dim ar As Variant
    Dim i As Integer
    Application.ScreenUpdating = False
    'Cell Ranges below, change to suit.
    ar = Array("B32", "B33")
    For i = 1 To UBound(ar)
    On Error Resume Next
    Set rng = Range(Range(ar(i)).MergeArea.Address)
        With rng
           .MergeCells = False
            cw = .Cells(1).ColumnWidth
            mw = 0
        For Each cM In rng
            cM.WrapText = True
            mw = cM.ColumnWidth + mw
        Next
        mw = mw + rng.Cells.Count * 0.66
        .Cells(1).ColumnWidth = mw
        .EntireRow.AutoFit
        rwht = .RowHeight
        .Cells(1).ColumnWidth = cw
        .MergeCells = True
        .RowHeight = rwht
        End With
    Next i
    Application.ScreenUpdating = True
End Sub

I also add a new script to loop through all of the worksheets in the workbook by using a 'For Each' loop, and inserted calls for SelectSheets and FixMerged. But this way only works on the current single sheet too.

Sub WorksheetLoop()
    Dim Current As Worksheet
    For Each Current In Worksheets
        SelectSheets
        FixMerged
    Next
End Sub

Passing a Worksheet Object to Another Procedure

The Calling Procedure

<!-- language: lang-vb -->

Sub FixMergedAll()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    
    For Each ws In wb.Worksheets
        FixMergedCells ws
    Next ws

    Application.ScreenUpdating = True

End Sub

The Called Procedure

• ' *** designates the locations of the introduced changes. For the rest, you're on your own.

<!-- language: lang-vb -->

Sub FixMergedCells(ByVal ws As Worksheet) ' ***
    
    Dim mw As Single
    Dim cM As Range
    Dim rng As Range
    Dim cw As Double
    Dim rwht As Double
    Dim ar As Variant
    Dim i As Long ' ***
    
    'Cell Ranges below, change to suit.
    ar = Array("B32", "B33")
    
    For i = LBound(ar) To UBound(ar) ' ***
        
        On Error Resume Next
        
        Set rng = ws.Range(ar(i)).MergeArea ' ***
        
        With rng
           
           .MergeCells = False
            cw = .Cells(1).ColumnWidth
            mw = 0
            
            For Each cM In rng
                cM.WrapText = True
                mw = cM.ColumnWidth + mw
            Next
            
            mw = mw + rng.Cells.Count * 0.66
            .Cells(1).ColumnWidth = mw
            .EntireRow.AutoFit
            rwht = .RowHeight
            .Cells(1).ColumnWidth = cw
            .MergeCells = True
            .RowHeight = rwht
        
        End With
    
    Next i

End Sub