Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Copy exact format

Posted on 2016-09-05
27
Medium Priority
?
122 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

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?
0
Comment
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 53

Accepted Solution

by:
Rgonzo1971 earned 1000 total points
ID: 41785663
Hi,

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

Regards
0
 
LVL 53

Expert Comment

by:Rgonzo1971
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

Open in new window

Regards
0
 
LVL 33

Expert Comment

by:Subodh Tiwari (Neeraj)
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

Open in new window

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 11

Author Comment

by:HuaMinChen
ID: 41787316
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
 
LVL 33

Assisted Solution

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

 Worksheets(Sheet0).Rows(I).Copy

Open in new window

1
 
LVL 11

Author Comment

by:HuaMinChen
ID: 41787349
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
 
LVL 33

Assisted Solution

by:Subodh Tiwari (Neeraj)
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 53

Expert Comment

by:Rgonzo1971
ID: 41787372
then try

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

Author Comment

by:HuaMinChen
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

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
 
LVL 33

Assisted Solution

by:Subodh Tiwari (Neeraj)
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

Open in new window

0
 
LVL 11

Author Comment

by:HuaMinChen
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

Open in new window

0
 
LVL 11

Author Comment

by:HuaMinChen
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

Open in new window

I still cannot copy the row with exact height.
0
 
LVL 53

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 1000 total points
ID: 41787692
0
 
LVL 11

Author Comment

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

Expert Comment

by:xtermie
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

Open in new window

0
 
LVL 18

Expert Comment

by:x-men
ID: 41791268
Rows(6).RowHeight = Rows(1).RowHeight
0
 
LVL 11

Author Comment

by:HuaMinChen
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

Open in new window

           
I cannot copy the row with the exactly same height.
0
 
LVL 18

Assisted Solution

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

try : .RowHeight = RowH

(drop the .EntireRow)
0
 
LVL 11

Author Comment

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

Expert Comment

by:x-men
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

by:HuaMinChen
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

Open in new window

but the problem persists!
0
 
LVL 18

Assisted Solution

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

.ROW(x).RowHeight
0
 
LVL 11

Author Comment

by:HuaMinChen
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

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
 
LVL 33

Expert Comment

by:Subodh Tiwari (Neeraj)
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

 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

Question has a verified solution.

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

I was prompted to write this article after the recent World-Wide Ransomware outbreak. For years now, System Administrators around the world have used the excuse of "Waiting a Bit" before applying Security Patch Updates. This type of reasoning to me …
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …

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

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

Join & Ask a Question