Reputation: 241
How can I amend the following code in order to copy not only the value but also the fonts style, e.g. bold or not bold. Thanks
Private Sub CommandButton1_Click()
Dim i As Integer
Dim a As Integer
a = 15
For i = 11 To 32
If Worksheets(1).Cells(i, 3) <> "" Then
Worksheets(2).Cells(a, 15) = Worksheets(1).Cells(i, 3).Value
Worksheets(2).Cells(a, 17) = Worksheets(1).Cells(i, 5).Value
Worksheets(2).Cells(a, 18) = Worksheets(1).Cells(i, 6).Value
Worksheets(2).Cells(a, 19) = Worksheets(1).Cells(i, 7).Value
Worksheets(2).Cells(a, 20) = Worksheets(1).Cells(i, 8).Value
Worksheets(2).Cells(a, 21) = Worksheets(1).Cells(i, 9).Value
a = a + 1
End If
Next i
Upvotes: 22
Views: 205472
Reputation: 115
Found this on OzGrid courtesy of Mr. Aaron Blood - simple direct and works.
Code:
Cells(1, 3).Copy Cells(1, 1)
Cells(1, 1).Value = Cells(1, 3).Value
However, I kinda suspect you were just providing us with an oversimplified example to ask the question. If you just want to copy formats from one range to another it looks like this...
Code:
Cells(1, 3).Copy
Cells(1, 1).PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
Upvotes: 2
Reputation: 116
This page from Microsoft's Excel VBA documentation helped me: https://learn.microsoft.com/en-us/office/vba/api/excel.xlpastetype
It gives a bunch of options to customize how you paste. For instance, you could xlPasteAll (probably what you're looking for), or xlPasteAllUsingSourceTheme, or even xlPasteAllExceptBorders.
Upvotes: 5
Reputation: 44871
Instead of setting the value directly you can try using copy/paste, so instead of:
Worksheets(2).Cells(a, 15) = Worksheets(1).Cells(i, 3).Value
Try this:
Worksheets(1).Cells(i, 3).Copy
Worksheets(2).Cells(a, 15).PasteSpecial Paste:=xlPasteFormats
Worksheets(2).Cells(a, 15).PasteSpecial Paste:=xlPasteValues
To just set the font to bold you can keep your existing assignment and add this:
If Worksheets(1).Cells(i, 3).Font.Bold = True Then
Worksheets(2).Cells(a, 15).Font.Bold = True
End If
Upvotes: 36
Reputation: 35557
Following on from jpw it might be good to encapsulate his solution in a small subroutine to save on having lots of lines of code:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim a As Integer
a = 15
For i = 11 To 32
If Worksheets(1).Cells(i, 3) <> "" Then
call copValuesAndFormat(i,3,a,15)
call copValuesAndFormat(i,5,a,17)
call copValuesAndFormat(i,6,a,18)
call copValuesAndFormat(i,7,a,19)
call copValuesAndFormat(i,8,a,20)
call copValuesAndFormat(i,9,a,21)
a = a + 1
End If
Next i
end sub
sub copValuesAndFormat(x1 as integer, y1 as integer, x2 as integer, y2 as integer)
Worksheets(1).Cells(x1, y1).Copy
Worksheets(2).Cells(x2, y2).PasteSpecial Paste:=xlPasteFormats
Worksheets(2).Cells(x2, y2).PasteSpecial Paste:=xlPasteValues
end sub
(I do not have Excel in current location so please excuse bugs as not tested)
Upvotes: 2