user3849959
user3849959

Reputation: 241

VBA copy cells value and format

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

Answers (4)

Apsis0215
Apsis0215

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

eyelesscactus54
eyelesscactus54

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

jpw
jpw

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

whytheq
whytheq

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

Related Questions