Значение и формат копии копии VBA

Как я могу изменить следующий код, чтобы скопировать не только значение, но и стиль шрифтов, например. полужирный или не жирный. Благодаря

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

Ответ 1

Вместо того, чтобы напрямую устанавливать значение, вы можете попробовать использовать copy/paste, поэтому вместо:

Worksheets(2).Cells(a, 15) = Worksheets(1).Cells(i, 3).Value

Попробуйте следующее:

Worksheets(1).Cells(i, 3).Copy
Worksheets(2).Cells(a, 15).PasteSpecial Paste:=xlPasteFormats
Worksheets(2).Cells(a, 15).PasteSpecial Paste:=xlPasteValues

Чтобы просто установить шрифт в жирный шрифт, вы можете сохранить существующее назначение и добавить это:

If Worksheets(1).Cells(i, 3).Font.Bold = True Then
  Worksheets(2).Cells(a, 15).Font.Bold = True
End If

Ответ 2

Вслед за jpw было бы неплохо инкапсулировать его решение в маленькую подпрограмму, чтобы сэкономить на наличии большого количества строк кода:

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

(У меня нет Excel в текущем местоположении, поэтому, пожалуйста, извините ошибки, если они не протестированы)

Ответ 3

Эта страница из документации Microsoft Excel VBA помогла мне: https://docs.microsoft.com/en-us/office/vba/api/excel.xlpastetype

Это дает кучу вариантов, чтобы настроить способ вставки. Например, вы можете xlPasteAll (возможно, то, что вы ищете), или xlPasteAllUsingSourceTheme, или даже xlPasteAllExceptBorders.

Ответ 4

Обнаружил это на OzGrid благодаря Аарону Бладу - все просто и работает.

Code:
Cells(1, 3).Copy Cells(1, 1)
Cells(1, 1).Value = Cells(1, 3).Value

Тем не менее, я подозреваю, что вы просто предоставили нам упрощенный пример, чтобы задать вопрос. Если вы просто хотите скопировать форматы из одного диапазона в другой, это выглядит так...

Code:
Cells(1, 3).Copy
    Cells(1, 1).PasteSpecial (xlPasteFormats)
    Application.CutCopyMode = False