如何粘贴值并保持源格式?

use*_*328 6 format excel vba

我试图将一些值从一个工作簿中的一列复制到另一个:

练习册 1

Column A
10/02/1990
41
11/01/2017
52
Run Code Online (Sandbox Code Playgroud)

练习册 2

Column I
10/02/1990
41
11/01/2017
52
Run Code Online (Sandbox Code Playgroud)

如果我只是从工作簿 A 的第 1 列复制我的值并将它们粘贴到工作簿 2 的第 I 列,我会得到如下结果:

Column I
34331
41
121092
52
Run Code Online (Sandbox Code Playgroud)

Excel 格式丢失/混淆。

所以我创建了一个按钮,用户可以在其中使用 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
Run Code Online (Sandbox Code Playgroud)

这些值保持其格式。但是,单元格格式也会发生变化。

我的意思是,工作簿 1 上的单元格有一个黑色边框,字体也是黑色和粗体。

我想保留工作簿 2 的字体和单元格边框。这是:

灰色边框,RGB(191, 191, 191)
灰色字体 (RGB 128, 128, 128)
字体大小:11
字体:Calibri

基本上它需要看起来像右边的列。

在此处输入图片说明

我试过这个,但它在我的电子表格中为不应该的范围添加了边框。

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
Run Code Online (Sandbox Code Playgroud)

我宁愿找到一种更简单的方法来粘贴这些值并保持它们的格式而不更改单元格格式和字体颜色等。

Tim*_*ams 6

有一个 PasteSpecial 选项:

ActiveSheet.Range("H10").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                 Operation:= xlNone, SkipBlanks:=False, Transpose:=False
Run Code Online (Sandbox Code Playgroud)