Forbedre en makro med flettede celler

JEg vil høre om jeg kan få hjælp til at forbedre en makro.
Makroen er fundet her på siden under følgende link:

http://www.eksperten.dk/spm/607343

Makroen autotilpasser højden på linier der er flettede, men jeg vil meget gerne have nogle ændringer så det passer til mit ark:

1.
For det første skal man stå på den linie man vil have autotilopasset.
Kan man ikke få den til at tilpasse alle linier i arket på en gang.


2.
Hvis man har har fået cellen til at være til passet til f.eks. 3 linier pga der meget tekst i cellen og man derefter sletter en del af teksten således der kun er brug for 2 linier, så tilpasser makroen ikke det...

Kan disse ting mon lade sig gøre?


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