Copy Cell Height

[Noz2k]

I have a range of cells which are copied and then pasted at the bottom of a sheet. However the cell height is not being copied. Which means that the cells in the pasted range look very clustered and also do not fill a page as I would like.

This is the code I am currently using

 Sheets("Report").UnProtect Password:="Password"
    Range("A220:N264").Select
    Selection.Copy
    Range("A265:N309").Select
    Selection.EntireRow.Hidden = False
    ActiveSheet.Paste
    ApplicationCutCopyMode = False
    ActiveSheet.PageSetup.PrintArea = "$A$1:$N$309"
    ActiveSheet.HPageBreaks.Add Before:=Range("A265")

What do I need to add, to ensure that the cell height is always copied?

 

[craig.penny]

Try this:

    Range("A265:N309").RowHeight = Range("A220:N264").RowHeight

 

[Noz2k]

Where would be the best place to put this, because it doesn't seem to be doing the trick unfortunately

 

[Noz2k]

There are lots of merged cells in the range, will this make a difference?

 

[Noz2k]

A little bit more of the code, in case it makes a difference.

Dim cl As Range
Dim clMerge As Range
 
    Range("A265").EntireRow.Hidden = True Then
    Sheets("Report").UnProtect Password:="Password"
    Range("A220:N264").Select
    Selection.Copy
    Range("A265:N309").Select
    Selection.EntireRow.Hidden = False
    ActiveSheet.Paste
    ApplicationCutCopyMode = False
    ActiveSheet.PageSetup.PrintArea = "$A$1:$N$309"
    ActiveSheet.HPageBreaks.Add Before:=Range("A265")
    Range("D268") = "2"
    Sheets("Sheet5").Protect Password:="Password"
        For Each cl In Sheets("Report").Range("A265:N309").Cells
                            If cl.Locked = False Then
                                If cl.MergeCells = True Then
                                    Set clMerge = Range(cl.Address).MergeArea
                                    clMerge.ClearContents
                                Else
                                    cl.ClearContents
                                End If
                            End If
                                Next cl

Still can't get this going, so any help would be greatly appreciated

 

[craig.penny]

After

ActiveSheet.Paste

Maybe

Range("A265:N309").Rows.AutoFit

Will get it close and then you could add a simple loop like

For i = 265 To 309
      Rows(i).RowHeight = Rows(i).RowHeight + 2
Next i

To increase the height a little bit.

Or maybe a loop like

For i = 220 to 264
      Rows(i+45).RowHeight = Rows(i).RowHeight
Next i

Would work.

 

[Noz2k]

Thanks,

That was the first place I tried it, but whilst it ran fine, it didn't seem to make any difference.

The problem with the other solutions is that within the range there are various heights for different rows.

 

[craig.penny]

Doesn't this duplicate the row heights?


For i = 220 to 264 Rows(i+45).RowHeight = Rows(i).RowHeightNext i</PRE>

 

[Noz2k]

Yes it does!

My understanding of that code was wrong on first reading. I thought it was just increasing the row height of every cell. (I forgot that the range contained 45 rows)

This has been frustrating me all day, so thank you very much for helping me out

 

[craig.penny]

I'm just happy to know it's working for you!

Cheers!