Solved

Copy exact format

Posted on 2016-09-05
27
99 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
  • 10
  • 5
  • 4
  • +2
27 Comments
 
LVL 48

Accepted Solution

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

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

Regards
0
 
LVL 48

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 28

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

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 28

Assisted Solution

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

 Worksheets(Sheet0).Rows(I).Copy

Open in new window

1
 
LVL 10

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 28

Assisted Solution

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

Row(I) should be Rows(I)
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 41787372
then try

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

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 28

Assisted Solution

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

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 10

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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 48

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 250 total points
ID: 41787692
0
 
LVL 10

Author Comment

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

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 10

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 125 total points
ID: 41793788
Line 19:  .EntireRow.RowHeight = RowH

try : .RowHeight = RowH

(drop the .EntireRow)
0
 
LVL 10

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 10

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 125 total points
ID: 41793976
not .Range().

.ROW(x).RowHeight
0
 
LVL 10

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 28

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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

760 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now