?
Solved

Copy exact format

Posted on 2016-09-05
27
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

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 52

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 52

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 32

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
Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 
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 32

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 32

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 52

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 32

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 52

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 32

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

NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

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.

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.

Join & Ask a Question