如何高效优化VBA中大量PasteSpecial xlPasteValues复制代码？

针对你提到的20处重复复制粘贴值的VBA代码，完全可以通过以下方式大幅提升效率，同时减少代码冗余：

1. 替换复制粘贴为直接赋值（核心优化） #

原生的Copy+PasteSpecial xlPasteValues会触发Excel剪贴板操作和界面刷新，效率较低。直接通过Range.Value赋值可以跳过这些环节，速度提升明显。

将你原来的代码：

RowItem = Application.WorksheetFunction.CountA(Range("ListA")) - 2

Range("Full_list").Resize(RowItem + 2).Copy
Range("Full_list").Offset(0, 1 + i).Resize(RowItem + 2).PasteSpecial xlPasteValues

替换为：

RowItem = Application.WorksheetFunction.CountA(Range("ListA")) - 2
With Range("Full_list").Resize(RowItem + 2)
    .Offset(0, 1 + i).Value = .Value
End With

2. 封装通用函数，消除重复代码 #

因为有20处类似逻辑，把核心逻辑封装成一个可复用的函数，避免重复编写相同代码，也方便后续维护：

Sub CopyValuesToOffset(sourceRangeName As String, listRangeName As String, offsetColumn As Integer)
    Dim rowCount As Long
    ' 获取有效行数
    rowCount = Application.WorksheetFunction.CountA(Range(listRangeName)) - 2
    ' 批量赋值
    With Range(sourceRangeName).Resize(rowCount + 2)
        .Offset(0, offsetColumn).Value = .Value
    End With
End Sub

之后每一处需要执行复制值的操作，只需要调用这一行代码即可：

' 示例调用，参数依次是源区域名称、计数用的列表区域名称、目标列偏移量
CopyValuesToOffset "Full_list", "ListA", 1 + i

3. 批量操作时的额外优化 #

如果这20处操作是连续执行的，可以在操作前后关闭Excel的屏幕刷新和事件触发，进一步提升运行速度：

' 关闭不必要的Excel功能
Application.ScreenUpdating = False
Application.EnableEvents = False

' 这里放置20次函数调用或者循环执行逻辑
' 例如：
' For i = 0 To 19
'     CopyValuesToOffset "Full_list", "ListA", 1 + i
' Next i

' 恢复Excel功能
Application.ScreenUpdating = True
Application.EnableEvents = True

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