VBA copy row height?

Question

I have a spreadsheet made in excel 2003 (saved as a macro enabled 2007 .xlsm spreadsheet) which uses queries to get data from SQL. I've made the spreadsheet read-only so users don't mess up my work, and use the following code to copy just the values from the master spreadsheet to a new one

Sub NewWB()
Dim wbNew As Workbook
Dim wbThis As Workbook
Dim rng As Range
Dim wbName As String
Dim Pic As Picture

wbName = ThisWorkbook.Name


 Set wbThis = Application.Workbooks(wbName)
 Set rng = wbThis.Worksheets("Report").Range("C1:AZ65336")
 Set wbNew = Workbooks.Add(xlWBATWorksheet)
 Set Pic = wbThis.Worksheets("Report").Pictures("Picture 2")
 With Pic
    With .ShapeRange
      .ScaleHeight 1#, msoScaleFromTopLeft
     .ScaleWidth 1#, msoScaleFromTopLeft
    End With
End With


 rng.Copy

 With wbNew

      .Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
      .Worksheets(1).Range("A1").PasteSpecial Paste:=8
      .Worksheets(1).Range("A1").PasteSpecial xlPasteFormats
 Pic.Copy
      .Worksheets(1).Paste
      .SaveAs Filename:=wbThis.Path & "\" & Left(wbName, InStr(wbName, ".") - 1) & _
        Format(Date, "_yyyy-mm-dd"), _
        FileFormat:=xlWorkbookNormal
 End With


'    wbThis.Close

End Sub

It works great with one small problem. It doesn't copy my row heights so the logo I copy ends up covering part of the data! It seems mind boggling to me that there would be a way to directly copy the columns but no way whatsoever to copy the rows.

What do I need to do to get the row height copied over as well, I'm working with the first 100 rows of the document.

Answer 1

I made two new variables

Dim rngNew as Range
Dim x As Integer

And edited my "With wbNew" section to have the following code

 With wbNew
      .Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats 'Paste only the values and how the values are formatted
      .Worksheets(1).Range("A1").PasteSpecial Paste:=8 ' Paste the column widths
      .Worksheets(1).Range("A1").PasteSpecial xlPasteFormats ' Paste cell formats (boarders, colors, etc)
      x = 1
      For Each rngNew In .Worksheets(1).Range("A1:A100") ' Set the range in the new worbook
        rngNew.EntireRow.RowHeight = wbThis.Worksheets("Report").Range("A" & CStr(x)).RowHeight 'Each row in the new workbook equals the equivilant row in the first workbook
        x = x + 1
      Next
      Pic.Copy ' Copy the logo
      .Worksheets(1).Paste ' Paste the Logo
      .SaveAs Filename:=wbThis.Path & "\" & Left(wbName, InStr(wbName, ".") - 1) & _
        Format(ReportDate, "_yyyy-mm-dd"), _
        FileFormat:=xlWorkbookNormal ' Save the workbook as a generic .xls
 End With

It's more crude than I would have hoped and it uses the assumption that I am starting at the top row (which is fine for what I'm doing) but it works barring a better answer.