none
Copy exact row height RRS feed

  • Question

  • Hi,

    Using these

                    Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
                    'Worksheets(Sheet0).Range(Str2).Copy
                    
                    'Worksheets(Sheet0).Rows(I).Copy
                    Worksheets(Sheet0).Range(Str2).EntireRow.Copy
                    'RowH = Worksheets(Sheet0).Range("A" & I).RowHeight
    
                    'Workbooks(OrigBook).Activate
                    RowID2 = RowID2 + 1
                    Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats
    
    I still cannot copy the row with exact height. Why?


    Many Thanks & Best Regards, Hua Min

    Wednesday, September 7, 2016 10:08 AM

Answers

  • Hi HuaMin Chen,

    Since there are some merged cells, I suggest that you could refer to below code:

    Sub Demo()
        Application.CutCopyMode = False
        Worksheets("115A").Activate
        Rows("1:5").Select
        Selection.Copy
            
        Worksheets("Sheet4").Activate
        Range("A1").Select
        ActiveSheet.Paste
            
        ActiveWindow.Zoom = 60
        Dim r As Long
        Set SourceRange = Worksheets("115A").Range("A6:AG6")
        Set TargetRange = Worksheets("Sheet4").Range("A6:AG6")
        With SourceRange
             For r = 1 To .Rows.Count
                   With .Rows(r).EntireRow
                         .Copy
                         RowH = .RowHeight
                   End With
                        
                    With TargetRange.Rows(r)
                          .PasteSpecial Paste:=xlPasteFormats
                          .PasteSpecial Paste:=xlPasteColumnWidths
                          .EntireRow.RowHeight = RowH
                    End With
             Next r
        End With
    End Sub

    Then you could get the result:

    Thanks for your understanding.

    • Edited by David_JunFeng Friday, September 16, 2016 7:57 AM
    • Marked as answer by Jackson_1990 Monday, September 19, 2016 4:39 AM
    Friday, September 16, 2016 7:56 AM

All replies

  • Does this work?

                    Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
                    With Worksheets(Sheet0).Range(Str2).EntireRow
                        .Copy
                        RowH = .RowHeight
                    End With
                    
                    RowID2 = RowID2 + 1
                    With Worksheets(Sheet0 & " Copy").Range("A" & RowID2)
                        .PasteSpecial Paste:=xlPasteFormats
                        .RowHeight = RowH
                    End With

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 7, 2016 1:31 PM
  • Sorry, using these            
                    Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
                    'Worksheets(Sheet0).Range(Str2).Copy
                    
                    'Worksheets(Sheet0).Rows(I).Copy
                    'Worksheets(Sheet0).Range(Str2).EntireRow.Copy
                    'RowH = Worksheets(Sheet0).Range("A" & I).RowHeight
                    With Worksheets(Sheet0).Range(Str2).EntireRow
                        .Copy
                        RowH = .RowHeight
                    End With
                    
                    'Workbooks(OrigBook).Activate
                    RowID2 = RowID2 + 1
                    'Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats
                    With Worksheets(Sheet0 & " Copy").Range("A" & RowID2)
                        .PasteSpecial Paste:=xlPasteFormats
                        .RowHeight = RowH
                    End With



    I still cannot copy the rows 1 to 6 of this Excel file.


    Many Thanks & Best Regards, Hua Min

    Thursday, September 8, 2016 2:00 AM
  • Hi HuaMin Chen,

    According to your description, can you copy the row with exact height manually? If can, you could use "Record Macro" to get VBA code, if not, I have downloaded your sample file, but I am not able to find out which sheet is you copy the row with exact height, could you provide screenshot? 

    Thanks for your understanding.

    Thursday, September 8, 2016 3:17 AM
  • Hi,

    I was to copy row 1 to 6 of sheet called 115A within the Workbook.


    Many Thanks & Best Regards, Hua Min

    Thursday, September 8, 2016 6:10 AM
  • Any other help?

    Many Thanks & Best Regards, Hua Min

    Saturday, September 10, 2016 2:46 PM
  • You have locked the VBA code in the workbook that you made available, so it is impossible to create or edit macros in the workbook...

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, September 10, 2016 3:26 PM
  • Can you please see this?

    Many Thanks & Best Regards, Hua Min

    Sunday, September 11, 2016 2:37 PM
  • Try changing the line

                        .RowHeight = RowH

    to

                        .EntireRow.RowHeight = RowH

    You may also want to set the zoom percentage of the new sheet to that of the source sheet. When the new sheet is active:

                    ActiveWindow.Zoom = 60


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, September 11, 2016 4:41 PM
  • Sorry, using these
                Workbooks(OrigBook).Activate
                ActiveWorkbook.Sheets.Add
                ActiveSheet.Name = Sheet0 & " Copy"
                
                For I = 1 To HeaderEndRow
                    Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
                    'Worksheets(Sheet0).Range(Str2).Copy
                    
                    With Worksheets(Sheet0).Range(Str2).EntireRow
                        .Copy
                        RowH = .RowHeight
                    End With
                    
                    'Workbooks(OrigBook).Activate
                    RowID2 = RowID2 + 1
                    'Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats
                    With Worksheets(Sheet0 & " Copy").Range("A" & RowID2)
                        .PasteSpecial Paste:=xlPasteFormats
                        .EntireRow.RowHeight = RowH
                    End With
                    'Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).RowHeight = RowH
                Next I
                


    I cannot copy the row with the exactly same height.

    Many Thanks & Best Regards, Hua Min

    Monday, September 12, 2016 2:36 AM
  • As far as I can tell, the code works. If it doesn't for you, I am out of ideas.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Monday, September 12, 2016 5:35 AM
  • Any other help to this?

    Many Thanks & Best Regards, Hua Min

    Monday, September 12, 2016 7:14 AM
  • Hi,

    You can try this free API and the following code to copy range with row height:

    Dim book As New Workbook()
    book.LoadFromFile(filePath + fileName, ExcelVersion.Version2010)
    Dim sheet As Worksheet = book.Worksheets(0)
    Dim RowH As [Double] = sheet.Range("A1:C1").RowHeight
    sheet.Copy(sheet.Range("A1:C1"), sheet.Range("A6:C6"), True)
    sheet.Range("A6:C6").RowHeight = RowH
    book.SaveToFile(filePath + fileName, ExcelVersion.Version2010)
    Note that this is a 3rd plug-in, if you do not mind, you could give it a try.



    Monday, September 12, 2016 8:02 AM
  • My codes in above are similar to yours. What to adjust to my codes to have the expected result/effect?

    Many Thanks & Best Regards, Hua Min

    Monday, September 12, 2016 8:43 AM
  • Any other help?

    Many Thanks & Best Regards, Hua Min

    Tuesday, September 13, 2016 7:00 AM
  • >>>My codes in above are similar to yours. What to adjust to my codes to have the expected result/effect?

    According to your description, what do you expect to get? Now, what do you get? Could you provide screenshot? I have made a sample, if the result is you want, refer to below:

    Application.CutCopyMode = False
    Rows("1:5").Select
    Selection.Copy
        
    Worksheets("Sheet8").Activate
    Range("A1").Select
    ActiveSheet.Paste
        
    ActiveWindow.Zoom = 60
    Dim r As Long
    Set SourceRange = Worksheets("115A").Range("A6")
    Set TargetRange = Worksheets("Sheet8").Range("A6")
    With SourceRange
         For r = 1 To .Rows.Count
               With .Rows(r).EntireRow
                     .Copy
                     RowH = .RowHeight
               End With
                    
    With TargetRange.Rows(r)
          .PasteSpecial Paste:=xlPasteFormats
          .EntireRow.RowHeight = RowH
    End With
                    
    Next r
    End With

    The result:


    Tuesday, September 13, 2016 8:52 AM
  • Hi,
    I want to be able to copy the highlighted area below (row 1-6) with the exact original row height. What to adjust to the codes?


    Many Thanks & Best Regards, Hua Min

    Tuesday, September 13, 2016 9:04 AM
  • Any help?

    Many Thanks & Best Regards, Hua Min

    Wednesday, September 14, 2016 1:53 AM
  • Hi HuaMin Chen,

    Since there are some merged cells, I suggest that you could refer to below code:

    Sub Demo()
        Application.CutCopyMode = False
        Worksheets("115A").Activate
        Rows("1:5").Select
        Selection.Copy
            
        Worksheets("Sheet4").Activate
        Range("A1").Select
        ActiveSheet.Paste
            
        ActiveWindow.Zoom = 60
        Dim r As Long
        Set SourceRange = Worksheets("115A").Range("A6:AG6")
        Set TargetRange = Worksheets("Sheet4").Range("A6:AG6")
        With SourceRange
             For r = 1 To .Rows.Count
                   With .Rows(r).EntireRow
                         .Copy
                         RowH = .RowHeight
                   End With
                        
                    With TargetRange.Rows(r)
                          .PasteSpecial Paste:=xlPasteFormats
                          .PasteSpecial Paste:=xlPasteColumnWidths
                          .EntireRow.RowHeight = RowH
                    End With
             Next r
        End With
    End Sub

    Then you could get the result:

    Thanks for your understanding.

    • Edited by David_JunFeng Friday, September 16, 2016 7:57 AM
    • Marked as answer by Jackson_1990 Monday, September 19, 2016 4:39 AM
    Friday, September 16, 2016 7:56 AM
  • Many thanks.

    How did you declare both SourceRange and TargetRange?


    Many Thanks & Best Regards, Hua Min

    Saturday, September 17, 2016 2:35 AM
  • That would be

        Dim SourceRange As Range
        Dim TargetRange As Range


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, September 17, 2016 9:32 AM