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 

Answer 1

而不是直接设置值，你可以尝试使用复制/粘贴，而不是：

 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 

Answer 2

接下来从jpw开始，将他的解决scheme封装在一个小的子程序中可能很好，以节省大量的代码：

 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，所以请原谅没有testing的错误）