Hvordan kan denne VBA-kode virke på et helt ark?

Hej.

Jeg har et problem, med at få justeret rækkehøjden på flettede celler, når der er mere end én linies tekst i dem.

Jeg har tilsyneladende fundet en løsning (http://www.eksperten.dk/spm/441428). Men denne VBA-kode virker kun på den markerede celle. Jeg vil gerne have den til at løbe igennem hele arket.

Public Sub AutoFitMergedCellRowHeight()
    Dim iCurrentRowHeight As Single
    Dim iMergedCellRgWidth As Single
    Dim iActiveCellWidth As Single
    Dim iPossNewRowHeight As Single
    Dim rCurCell As Range
   
    If ActiveCell.MergeCells Then
      With ActiveCell.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                .EntireRow.AutoFit
                iCurrentRowHeight = .RowHeight
                iActiveCellWidth = ActiveCell.ColumnWidth
                For Each rCurCell In Selection
                    iMergedCellRgWidth = rCurCell.ColumnWidth + iMergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = iMergedCellRgWidth
                .EntireRow.AutoFit
                iPossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = iActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(iCurrentRowHeight > iPossNewRowHeight, _
                iCurrentRowHeight, iPossNewRowHeight)
            End If
        End With
    End If

    Set rCurCell = Nothing
End Sub



Er der nogen, som har et input, til hvordan det kan lade sig gøre?