Sub tobi76()
Dim RG0 As Excel.Range
Dim RG1 As Excel.Range
Dim RG2 As Excel.Range
Dim i As Long
Dim wAll As Double
Dim wEin As Double
Dim hig As Double
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For Each RG0 In Worksheets("RF").Range("A1.Z500").Cells
    If RG0.MergeArea.Cells.Count > 1 _
    And RG0.MergeArea.Cells(1) = RG0 Then
        Set RG1 = RG0.MergeArea.Cells
        wEin = RG1.Columns(1).ColumnWidth
        wAll = 0
        For Each RG2 In RG1.Columns
            wAll = wAll + RG2.ColumnWidth
        Next RG2
        Set RG2 = RG0.MergeArea.Cells
        RG1.MergeCells = False
        RG1.ColumnWidth = wAll
        RG1.WrapText = True
        RG2.Rows.AutoFit
        hig = RG1.Height / RG2.Rows.Count
        RG1.ColumnWidth = wEin
        RG2.MergeCells = True
        For Each RG1 In RG2.Rows
            RG1.RowHeight = hig
        Next RG1
    End If
Next RG0
End Sub