VBA copy cells value and format

Question

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_Cli         


        

Answer 1

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

Answer 2

This page from Microsoft's Excel VBA documentation helped me: https://docs.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.

Answer 3

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

Answer 4

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)