autohøjde på flettede celler

Jeg har fundet nednestående makro her på siden og den virker fint for mig.

Makroen autojusterer højden på celler selvom de er flettede.

Dt eneste der er galt er at den kun virker præcis i den celle der er aktiv.

Kan man få den til at løbe f.esk. hele kolonne A igennem og justere højden på alle linierne istedet for kun at justere/køre på den aktive celle.


Makroen er hentet fra dette spørgsmål
http://www.eksperten.dk/spm/607343


Sub AutoFitMergedCellRowHeight()
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If ActiveCell.MergeCells Then
      With ActiveCell.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = ActiveCell.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
End Sub

Den er skrevet af
Jim Rech
Excel MVP