The macro below is what I have used for quite a while to transfer row heights
to other areas. Add it to a general module in your workbook, or to
PERSONAL.XLS so that it is always available. Select the row or rows that
have the row heights you want to copy/paste. Then select one or more
additional areas (using the CTRL key) to which you want to transfer the row
heights. Then run the macro. I have also added a custom button to my
toolbar so that I can quickly access the "Paste Row Heights" macro.
HTH,
Eric
'
' This macro will transfer the row height(s) from the
' first area of a multi-area selection to the remaining
' areas of a multi-area selection.
'
Sub Transfer_Row_Heights()
Dim i As Long, j As Long, k As Long
Dim rowHgt1 As Single, rowHgt2 As Single
Dim theStr As String
Dim nAreas As Integer
Dim nRows1 As Long ' Number of rows in first area
Dim nRows2 As Long ' Number of rows in other areas
'
' First make sure user has selected multiple areas
'
If (Selection.Areas.Count < 2) Then
MsgBox "You must select at least two separate areas" & Chr(10) & _
"for this routine to work!" & Chr(10) & Chr(10) & _
"Please select two or more areas (using CTRL-select" &
Chr(10) & _
"and try again."
Exit Sub
End If
'
nAreas = Selection.Areas.Count
nRows1 = Selection.Areas(1).Rows.Count
'
' Go through each selected areas and set the row heights
' based on the row height(s) in the first selected area.
'
For i = 2 To nAreas
nRows2 = Selection.Areas(2).Rows.Count
k = 0
For j = 1 To nRows2
k = k + 1
If (k > nRows1) Then k = 1 ' Cycle through rows in first area...
Selection.Areas(i).Rows(j).RowHeight = _
Selection.Areas(1).Rows(k).RowHeight
Next j ' Next row in current selected area
Next i ' Next selected area
'
End Sub
