Auto Fit række højden ved Merged Cells

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single
Dim MergedCellRgWidth As Single
Dim ActiveCellWidth As Single
Dim PossNewRowHeight As Single
Dim CurrCell As Range

If Not Intersect(Target, Range("B50")) Is Nothing Then

    Range("B50").Select

    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 = PossNewRowHeight
            End If
        End With
    End If
End If
    Application.ScreenUpdating = True
End Sub