Solved

# Copy exact format

Posted on 2016-09-05
Medium Priority
119 Views
Last Modified: 2016-09-27
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
``````
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?
0
Question by:HuaMinChen
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• Learn & ask questions
• 10
• 5
• 4
• +2
27 Comments

LVL 52

Accepted Solution

Rgonzo1971 earned 1000 total points
ID: 41785663
Hi,

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

Regards
0

LVL 52

Expert Comment

ID: 41785677
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
``````
Regards
0

LVL 32

Expert Comment

ID: 41785678
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
``````
0

LVL 11

Author Comment

ID: 41787316
Thanks to all.
Sorry to that I get

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
``````
0

LVL 32

Assisted Solution

Subodh Tiwari (Neeraj) earned 500 total points
ID: 41787326
It should be like this....

`````` Worksheets(Sheet0).Rows(I).Copy
``````
1

LVL 11

Author Comment

ID: 41787349
Sorry, I still get

due to last line below
``````                Str2 = "A" & Trim(CStr(I)) & ":AP" & Trim(CStr(I))
'Worksheets(Sheet0).Range(Str2).Copy
Worksheets(Sheet0).Row(I).Copy
``````
0

LVL 32

Assisted Solution

Subodh Tiwari (Neeraj) earned 500 total points
ID: 41787354
Probably you didn't pay attention to my last post.

Row(I) should be Rows(I)
0

LVL 52

Expert Comment

ID: 41787372
then try

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

LVL 11

Author Comment

ID: 41787374
Using these
``````                Worksheets(Sheet0).Rows(I).Copy
'Workbooks(OrigBook).Activate
RowID2 = RowID2 + 1
Worksheets(Sheet0 & " Copy").Range("A" & Trim(CStr(RowID2))).PasteSpecial Paste:=xlPasteFormats
``````

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

LVL 32

Assisted Solution

Subodh Tiwari (Neeraj) earned 500 total points
ID: 41787380
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
``````
0

LVL 11

Author Comment

ID: 41787399
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
``````
0

LVL 11

Author Comment

ID: 41787534
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
``````
I still cannot copy the row with exact height.
0

LVL 52

Assisted Solution

Rgonzo1971 earned 1000 total points
ID: 41787692
0

LVL 11

Author Comment

ID: 41788983
Yes, I did try with your way to use 'EntireRow' instead, as I mentioned in above.
0

LVL 18

Expert Comment

ID: 41791150
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
``````
0

LVL 18

Expert Comment

ID: 41791268
Rows(6).RowHeight = Rows(1).RowHeight
0

LVL 11

Author Comment

ID: 41793662
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.
0

LVL 18

Assisted Solution

x-men earned 500 total points
ID: 41793788
Line 19:  .EntireRow.RowHeight = RowH

try : .RowHeight = RowH

(drop the .EntireRow)
0

LVL 11

Author Comment

ID: 41793836
Even if I've removed 'EntireRow' in above, I still cannot copy the row with exact height.
0

LVL 18

Expert Comment

ID: 41793931
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

LVL 11

Author Comment

ID: 41793938
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
``````
but the problem persists!
0

LVL 18

Assisted Solution

x-men earned 500 total points
ID: 41793976
not .Range().

.ROW(x).RowHeight
0

LVL 11

Author Comment

ID: 41795574
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
``````
I still cannot copy the row with exact height, when running the macro, within the attached Excel file.
115_-------.xls
0

LVL 32

Expert Comment

ID: 41817624
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

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Outlook for dependable use in a very small business Â  This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This â€¦
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
###### Suggested Courses
Course of the Month13 days, 13 hours left to enroll

#### 801 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.