Solved

Copy exact format

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

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 49

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 29

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
Does Powershell have you tied up in knots?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

 
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 29

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 29

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 49

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 29

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

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 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 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 29

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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

Outlook Free & Paid Tools
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
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…

831 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