VBA 复制单元格值和格式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/25461314/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA copy cells value and format
提问by user3849959
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
回答by jpw
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
回答by whytheq
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:
继 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
(I do not have Excel in current location so please excuse bugs as not tested)
（我在当前位置没有 Excel，所以请原谅未测试的错误）
回答by eyelesscactus54
This page from Microsoft's Excel VBA documentation helped me: https://docs.microsoft.com/en-us/office/vba/api/excel.xlpastetype
Microsoft 的 Excel VBA 文档中的此页面帮助了我：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.
它提供了一系列选项来自定义粘贴方式。例如，您可以使用xlPasteAll（可能是您要查找的内容）或xlPasteAllUsingSourceTheme，甚至xlPasteAllExceptBorders。
回答by Apsis0215
Found this on OzGridcourtesy of Mr. Aaron Blood - simple direct and works.
由 Aaron Blood 先生在OzGrid上找到了这个- 简单直接且有效。
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
