Row Height VBA

[steveuk87]

HELP!!

I need to copy a form over from one sheet to another, i can do this perfectly, only problem is there is alot of formatting etc that i also need taking across.

This is all complete except the row heights... Column widths are fine, but the row heights i just cant get right.

My problem is the amount of data to copy across is variable, and also the data in each section is variable to i cant just preset the same gaps in row heights... is there an easy way with VBA?

 

[Kenneth Hobson]

I don't know what you mean by Form. If you mean copy a range and paste to another:

Sub RunCopyPasteAll()
    Dim rSource As Range, rTarget As Range, s As String
    Set rSource = Application.InputBox("Select Source Range to Copy from:", "Source Range", Type:=8)
    Set rTarget = Application.InputBox("Target Cell to Paste to:", "Target Cell", Type:=8)
    CopyPasteAll rSource, rTarget
End Sub

Sub CopyPasteAll(rSource As Range, rTarget As Range)
    Dim r As Long, c As Long
    
    Application.DisplayAlerts = False
    
    With rSource
        .Copy rTarget
        .Copy
        rTarget.PasteSpecial xlPasteColumnWidths
        For r = 1 To .Rows.Count
            rTarget.Rows(r).RowHeight = .Rows(r).RowHeight
        Next r
    End With
    
    Application.DisplayAlerts = True
    Application.CutCopyMode = False
End Sub

 

[steveuk87]

Thanks for your response Kenneth, Unfortunately your solution didn't work but i have been able to solve it...

I used the following code to input the size of the rows into a cell:

Sub RowHeight()

r = 1
Do While r < 459
ActiveCell.Value = Rows(r).RowHeight
ActiveCell.Offset(1, 0).Select
r = r + 1
Loop

End Sub

after that i then changed the row heights in then new workbook with the following:

Range("A1").Select
r = 1
Do While ActiveCell <> ""
Rows(r).RowHeight = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
r = r + 1
Loop

This does what i need now.