如何在Excel VBA中实现仅复制粘贴数值、不保留原格式？

原代码问题 #

你当前写法中Range.Copy 目标区域的语法会直接完成「复制+粘贴全内容（含格式、公式）」的操作，末尾的ActiveCell.PasteSpecial仅能作用于最后一次复制的缓存内容，且目标是当前激活的单元格，完全不符合需求。

方案1：调整粘贴逻辑适配需求 #

将每一行的复制、粘贴操作拆分，显式指定仅粘贴数值，修改后的代码如下：

Sub CopyCoverage()
    
    Dim x As Worksheet, y As Worksheet, LastRow As Long
    
    Set x = Sheets("1SalesAnalysis")
    Set y = Sheets("Basics")
    
    LastRow = x.Cells.SpecialCells(xlCellTypeLastCell).Row
    
    x.Range("A2:A" & LastRow).Copy
    y.Cells(y.Rows.Count, "E").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("B2:B" & LastRow).Copy
    y.Cells(y.Rows.Count, "F").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("C2:C" & LastRow).Copy
    y.Cells(y.Rows.Count, "G").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("D2:D" & LastRow).Copy
    y.Cells(y.Rows.Count, "L").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("E2:E" & LastRow).Copy
    y.Cells(y.Rows.Count, "M").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("F2:F" & LastRow).Copy
    y.Cells(y.Rows.Count, "P").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("G2:G" & LastRow).Copy
    y.Cells(y.Rows.Count, "Q").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("H2:H" & LastRow).Copy
    y.Cells(y.Rows.Count, "R").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("I2:I" & LastRow).Copy
    y.Cells(y.Rows.Count, "S").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("J2:J" & LastRow).Copy
    y.Cells(y.Rows.Count, "T").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("K2:K" & LastRow).Copy
    y.Cells(y.Rows.Count, "V").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("L2:L" & LastRow).Copy
    y.Cells(y.Rows.Count, "W").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("O2:O" & LastRow).Copy
    y.Cells(y.Rows.Count, "EA").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("P2:P" & LastRow).Copy
    y.Cells(y.Rows.Count, "EI").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("Q2:Q" & LastRow).Copy
    y.Cells(y.Rows.Count, "EB").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("R2:R" & LastRow).Copy
    y.Cells(y.Rows.Count, "EJ").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("S2:S" & LastRow).Copy
    y.Cells(y.Rows.Count, "EC").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("T2:T" & LastRow).Copy
    y.Cells(y.Rows.Count, "EK").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    Application.CutCopyMode = False
End Sub

方案2（更推荐）：直接区域赋值，跳过剪贴板 #

不需要调用Copy方法，直接让目标区域的值等于源区域的值，既不会带格式，运行效率也更高，且不会影响用户系统剪贴板的原有内容，完整代码如下：

Sub CopyCoverage()
    
    Dim x As Worksheet, y As Worksheet, LastRow As Long
    Dim dataRowsCount As Long
    
    Set x = Sheets("1SalesAnalysis")
    Set y = Sheets("Basics")
    
    LastRow = x.Cells.SpecialCells(xlCellTypeLastCell).Row
    dataRowsCount = LastRow - 1 ' 计算第2行到最后一行的总数据行数
    
    y.Cells(y.Rows.Count, "E").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("A2:A" & LastRow).Value
    y.Cells(y.Rows.Count, "F").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("B2:B" & LastRow).Value
    y.Cells(y.Rows.Count, "G").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("C2:C" & LastRow).Value
    y.Cells(y.Rows.Count, "L").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("D2:D" & LastRow).Value
    
    y.Cells(y.Rows.Count, "M").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("E2:E" & LastRow).Value
    y.Cells(y.Rows.Count, "P").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("F2:F" & LastRow).Value
    y.Cells(y.Rows.Count, "Q").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("G2:G" & LastRow).Value
    y.Cells(y.Rows.Count, "R").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("H2:H" & LastRow).Value
    
    y.Cells(y.Rows.Count, "S").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("I2:I" & LastRow).Value
    y.Cells(y.Rows.Count, "T").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("J2:J" & LastRow).Value
    y.Cells(y.Rows.Count, "V").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("K2:K" & LastRow).Value
    y.Cells(y.Rows.Count, "W").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("L2:L" & LastRow).Value
    
    y.Cells(y.Rows.Count, "EA").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("O2:O" & LastRow).Value
    y.Cells(y.Rows.Count, "EI").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("P2:P" & LastRow).Value
    y.Cells(y.Rows.Count, "EB").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("Q2:Q" & LastRow).Value
    
    y.Cells(y.Rows.Count, "EJ").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("R2:R" & LastRow).Value
    y.Cells(y.Rows.Count, "EC").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("S2:S" & LastRow).Value
    y.Cells(y.Rows.Count, "EK").End(xlUp).Offset(1, 0).Resize(dataRowsCount, 1).Value = x.Range("T2:T" & LastRow).Value
    
End Sub

内容的提问来源于stack exchange，提问作者Sven