Copy exact format

Hi,
I want to copy also the row height, from row 1 to row 6, by these codes
                Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
                Worksheets(Sheet0).Range(Str2).Copy
                'Workbooks(OrigBook).Activate
                RowID2 = RowID2 + 1
                Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats

Open in new window

If you see the attached Excel file, some rows is having short height. How to ensure the above to achieve what I expect to have?
LVL 11
HuaMin ChenSystem AnalystAsked:
Who is Participating?
 
Rgonzo1971Connect With a Mentor Commented:
Hi,

To copy the row height, you have to copy the entire row

Regards
0
 
Rgonzo1971Commented:
then try
                Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
                Worksheets(Sheet0).Range(Str2).Copy
                'Workbooks(OrigBook).Activate
                RowID2 = RowID2 + 1
                Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).RowHeight _
                        = Worksheets(Sheet0).Range(Str2).RowHeight
                Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats

Open in new window

Regards
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may declare a variable to hold the row height of the source row and then assign the row height to the destination cell.

Please try this....(Untested)
Dim rh As Double
Str2 = "A" & Trim(CStr(i)) & ":AP" & Trim(CStr(i))
rh = Worksheets(Sheet0).Range("A" & Trim(CStr(i))).RowHeight
Worksheets(Sheet0).Range(Str2).Copy
'Workbooks(OrigBook).Activate
RowID2 = RowID2 + 1
Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats
Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).RowHeight = rh

Open in new window

0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
HuaMin ChenSystem AnalystAuthor Commented:
Thanks to all.
Sorry to that I get
7p.png
due to last line below.
                Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
                'Worksheets(Sheet0).Range(Str2).Copy
                Worksheets(Sheet0).Row(I).EntireRow.Copy

Open in new window

0
 
Subodh Tiwari (Neeraj)Connect With a Mentor Excel & VBA ExpertCommented:
It should be like this....

 Worksheets(Sheet0).Rows(I).Copy

Open in new window

1
 
HuaMin ChenSystem AnalystAuthor Commented:
Sorry, I still get
7q.png
due to last line below
                Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
                'Worksheets(Sheet0).Range(Str2).Copy
                Worksheets(Sheet0).Row(I).Copy

Open in new window

0
 
Subodh Tiwari (Neeraj)Connect With a Mentor Excel & VBA ExpertCommented:
Probably you didn't pay attention to my last post.

Row(I) should be Rows(I)
0
 
Rgonzo1971Commented:
then try

Worksheets(Sheet0).Range(Str2).EntireRow.Copy
0
 
HuaMin ChenSystem AnalystAuthor Commented:
Using these
                Worksheets(Sheet0).Rows(I).Copy
                'Workbooks(OrigBook).Activate
                RowID2 = RowID2 + 1
                Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats

Open in new window


I want to copy exactly the format of first 6 rows (with the same height), from first sheet of the attached Excel file. What to adjust in the codes?
115_-------.xls
0
 
Subodh Tiwari (Neeraj)Connect With a Mentor Excel & VBA ExpertCommented:
Your VBA project is protected.

BTW did you try the following code?
Dim rw As Double
Worksheets(Sheet0).Rows(I).Copy
rw = Worksheets(Sheet0).Range("A" & I).RowHeight
'Workbooks(OrigBook).Activate
RowID2 = RowID2 + 1
Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats
Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).RowHeight = rw

Open in new window

0
 
HuaMin ChenSystem AnalystAuthor Commented:
I declare RowH as Double but I still cannot copy the exact row height by these
                Worksheets(Sheet0).Rows(I).Copy
                
                Worksheets(Sheet0).Rows(I).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
                Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).RowHeight = RowH

Open in new window

0
 
HuaMin ChenSystem AnalystAuthor Commented:
then try

Worksheets(Sheet0).Range(Str2).EntireRow.Copy

Many thanks to all.

Rgonzo,

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

Open in new window

I still cannot copy the row with exact height.
0
 
HuaMin ChenSystem AnalystAuthor Commented:
Yes, I did try with your way to use 'EntireRow' instead, as I mentioned in above.
0
 
xtermieCommented:
Try to enumerate the copied rows AFTER you paste them...from the new and old worksheet...
you will need something like
' add these to your declarations
Dim rngNew as Range
Dim x As Integer

'<your code to copy here>>>
'<where you copy from one sheet to another>
x= 1
For Each rngNew In .Worksheets(1).Range("A1:A100")  ' Set your range of the copied rows
       rngNew.EntireRow.RowHeight = wbThis.Worksheets("Sheet0").Range("A" & CStr(x)).RowHeight  'Each row in the new workbook equals the equivalent row in the first workbook
        x = x + 1
Next

Open in new window

0
 
x-menIT super heroCommented:
Rows(6).RowHeight = Rows(1).RowHeight
0
 
HuaMin ChenSystem AnalystAuthor Commented:
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

Open in new window

           
I cannot copy the row with the exactly same height.
0
 
x-menConnect With a Mentor IT super heroCommented:
Line 19:  .EntireRow.RowHeight = RowH

try : .RowHeight = RowH

(drop the .EntireRow)
0
 
HuaMin ChenSystem AnalystAuthor Commented:
Even if I've removed 'EntireRow' in above, I still cannot copy the row with exact height.
0
 
x-menIT super heroCommented:
21:'Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).RowHeight = RowH

instead of .Range, try a loop (for i = 1 to RowID2) to set each cell's rowheight
0
 
HuaMin ChenSystem AnalystAuthor Commented:
I'm actually doing for every row like
           
            For I = 1 To HeaderEndRow
                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
                    '.EntireRow.RowHeight = RowH
                    .RowHeight = RowH
                End With
                'Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).RowHeight = RowH
            Next I

Open in new window

but the problem persists!
0
 
x-menConnect With a Mentor IT super heroCommented:
not .Range().

.ROW(x).RowHeight
0
 
HuaMin ChenSystem AnalystAuthor Commented:
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
                
                'Worksheets(Sheet0).Rows(I).Copy
                'Worksheets(Sheet0).Range(Str2).EntireRow.Copy
                'RowH = Worksheets(Sheet0).Range("A" & I).RowHeight
                'With Worksheets(Sheet0).Range(Str2).EntireRow
                With Worksheets(Sheet0).Rows(I).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)
                With Worksheets(Sheet0 & " Copy").Rows(RowID2)
                    .PasteSpecial Paste:=xlPasteFormats
                    '.EntireRow.RowHeight = RowH
                    .RowHeight = RowH
                End With

Open in new window

I still cannot copy the row with exact height, when running the macro, within the attached Excel file.
115_-------.xls
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Points should be split between all the experts as none of the solution works at the OP's end and the solution provided by each experts works at their end without an issue.
The chosen solution by x-men's doesn't contain anything which is not provided by me or Rgonzo, the problem is the merged cells which I assume x-men's is not aware of.
So my proposal is either split the points between all the experts equally or just delete the question without accepting any answer as none of them worked for OP due to reason I mentioned.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.