Paste row height.

[Jonno]

Is it possible to paste purely a row height (no formats, values etc.)

It's simple enough to paste a column width using the Paste Special command, but what about rows - they seem a bit neglected

Thanks,

Jonno.

 

[Jonno]

Jimboy,

That's looking pretty good! Any chance of modding it so that the 'from' and 'to' rows can be physically picked? That would be great!

Cheers again,

Jonno.

 

[Tom Urtis]

Thanks Tom. Your code does do want I need regarding matching the row heights, but I'd like to be able to select the 'from' and 'to' rows.

This would do that for a single "copy" row...after that the code gets even kludgier than this, which is already getting messy. With this you can copy one row's height to a single row or optional range of rows. The default of the From row is the active row but you can change it in the input box to any row.


Sub Test1()
Dim FromRow As String, StartRow As String, EndRow As String
FromRow = InputBox("Enter the row whose height you want to copy.", "Paste height of what row?", ActiveCell.Row)
If IsNumeric(FromRow) = False Then Exit Sub
If Int(FromRow) < 1 Or Int(FromRow) > 65536 Then Exit Sub
StartRow = InputBox("What is the first row in a range where" & vbCrLf & "you want to copy the height of row " & FromRow & "?", "Start from where?")
If IsNumeric(StartRow) = False Then Exit Sub
If Int(StartRow) < 1 Or Int(StartRow) > 65536 Then Exit Sub
EndRow = InputBox("What is the last row in a range where" & vbCrLf & "you want to copy the height of row " & FromRow & "?", "OPTIONAL - Ending where?")
If IsNumeric(EndRow) = False And Len(EndRow) <> 0 Then Exit Sub
If EndRow <> "" Then
If Int(EndRow) > 0 Or Int(EndRow) <= 65536 Then
Range(StartRow & ":" & EndRow).RowHeight = Rows(FromRow).RowHeight
End If
Else
Rows(StartRow).RowHeight = Rows(FromRow).RowHeight
End If
End Sub

And yes, Application.InputBox is an alternative but the method posted above allows for not worrying about the user creating an error by not entering a column row range separator, or inconveniencing the user to scroll down 60,000 rows to select a certain obscure destination row number.

 

[murtiizzet]

1. Select the row you would like to copy.
2. Click on the Format Painter icon on your Standard toolbar (or on the Home tab is you are using version 2007).
3. You will now see a small paint brush.
4. Simply drag it where you would like to copy the row height.

That’s all there is to it! You have now copied the format to your new row.

 

[bmurn]

Is there a way to do code in VBA to copy a series of row heights and paste them sequentially over a range of rows?

So if one of my sheets has rows 1-10 with heights 2,3,4,1,2,3,5,3,1, and 2, is there a way to copy all these heights by highlighting all the rows, kinda like paste column width, and then click row a different row on another sheet, hit the macro, and have it basically emulate paste column width in that it will paste those row heights sequentially from row n to n+9, whichever row "n" you start at.

Please help!

 

[bmurn]

Is there a way to do code in VBA to copy a series of row heights and paste them sequentially over a range of rows?

So if one of my sheets has rows 1-10 with heights 2,3,4,1,2,3,5,3,1, and 2, is there a way to copy all these heights by highlighting all the rows, kinda like paste column width, and then click row a different row on another sheet, hit the macro, and have it basically emulate paste column width in that it will paste those row heights sequentially from row n to n+9, whichever row "n" you start at.

Please help!

Dim heightValues() As String, rowCount As String
Sub CopyRowHeight()
Dim iCount As Integer, adjCount As Integer, startRow As String
'read row height values for selected rows in active sheet
startRow = ActiveCell.Row
rowCount = Selection.Rows.Count
ReDim heightValues(1 To rowCount)
For iCount = 1 To rowCount
adjCount = iCount + startRow - 1
heightValues(iCount) = Rows(adjCount).RowHeight
Next iCount
End Sub
Sub PasteRowHeight()
Dim iCount As Integer, adjCount As Integer, startRow As String
startRow = ActiveCell.Row
For iCount = 1 To rowCount
adjCount = iCount + startRow - 1
Rows(adjCount).RowHeight = heightValues(iCount)
Next iCount
End Sub

Why wont this work? I'm having trouble with the variables keeping correct between the copy and paste sub in the same module.

 

[netwebdave]

Highlight rows (not cells).
Copy.
Highlight rows to paste --> Paste Special --> Multiply

 

[HipGecko]

Sub CopyRowHeights()

Dim SourceRange As Range
Dim TargetRange As Range
Dim r As Long

Set SourceRange = Worksheets("Sheet1").Range("A1:A1000")
Set TargetRange = Worksheets("Sheet2").Range("A1:A1000")

With SourceRange
For r = 1 To .Rows.Count
TargetRange.Rows(r).RowHeight = .Rows(r).RowHeight
Next r
End With

End Sub