vba 粘贴值并保持源格式？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/41725730/
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 paste values and keep source formatting?
提问by user7415328
I am trying to copy and paste some value from a column in one workbook to another:
我正在尝试将一个工作簿中的某个列中的一些值复制并粘贴到另一个：
Workbook 1
练习册 1
Column A
10/02/1990
41
11/01/2017
52
Workbook 2
练习册 2
Column I
10/02/1990
41
11/01/2017
52
The problem i am getting is if i simply copy my values from column 1 in workbook A and paste them to column I in workbook 2. then i get results like so:
我遇到的问题是，如果我只是从工作簿 A 的第 1 列复制我的值并将它们粘贴到工作簿 2 的第 I 列，那么我会得到如下结果：
Column I
34331
41
121092
52
This is because the formatting is somehow getting lost/confused by excel.
这是因为格式在某种程度上被 excel 丢失/混淆了。
So i have created a button where users can paste this data using vba like so:
所以我创建了一个按钮，用户可以在其中使用 vba 粘贴这些数据，如下所示：
Sub Paste3()
Dim lastRow As Long
On Error GoTo ErrorHandler
lastRow = ActiveSheet.Range("H" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("H10").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False
Exit Sub
ErrorHandler:
MsgBox "Please Copy Values First."
End Sub
This works and the values keep their formatting. However, the cell format also changes.
这有效并且值保持其格式。但是，单元格格式也会发生变化。
What i mean by this is, the cells on workbook 1 have a black border, and the font is also black and bold.
我的意思是，工作簿 1 上的单元格有一个黑色边框，字体也是黑色和粗体。
I want to try and preserver workbook 2's font and cell border. This is:
我想尝试保存工作簿 2 的字体和单元格边框。这是：
Grey border, RGB(191, 191, 191) Grey Font (RGB 128, 128, 128) Font Size: 11 Font: Calibri
灰色边框，RGB(191, 191, 191) 灰色字体 (RGB 128, 128, 128) 字体大小：11 字体：Calibri
Essentially it needs to look like the column to the right.
本质上，它需要看起来像右边的列。
I have tried this, but it doesn't work right, it adds borders to ranges in my spreadsheet it isn't supposed to.
我试过这个，但它不起作用，它在我的电子表格中为不应该的范围添加了边框。
Sub Paste3()
Dim lastRow As Long
On Error GoTo ErrorHandler
lastRow = ActiveSheet.Range("H" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("H10").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False
Dim rng As Range
Set rng = Range("H10:H" & lastRow)
With rng.Borders
.LineStyle = xlContinuous
.Color = RGB(191, 191, 191)
.Weight = xlThin
.Font
End With
With rng.Font
.TextColor = RGB(128, 128, 128)
.Font.Name = "Calibri"
.Size = 11
.Bold = False
End With
Exit Sub
ErrorHandler:
MsgBox "Please Copy Values First."
End Sub
To be honest i would rather just find an easier way of pasting these values and keeping their format without changing the cell format and font colour etc.
老实说，我宁愿找到一种更简单的方法来粘贴这些值并保持其格式，而无需更改单元格格式和字体颜色等。
Please can someone show me where i am going wrong?
请有人告诉我我哪里出错了？
回答by Tim Williams
There's a PasteSpecial option for this:
有一个 PasteSpecial 选项：
ActiveSheet.Range("H10").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:= xlNone, SkipBlanks:=False, Transpose:=False
回答by Prakhar Srivastava
Instead of just try< Paste:=xlPasteAll> once
而不是仅仅尝试一次< Paste:=xlPasteAll>
