如何优化同工作簿跨表逐行粘贴单元格值的VBA宏代码

原代码运行效率极低的核心原因有三点：

• 大量使用Select、ActiveSheet、ActiveCell这类模拟人工点选操作的语句，会触发不必要的工作表切换、屏幕刷新，产生大量无意义的性能开销
• 调用系统剪贴板执行Copy+PasteSpecial操作，对于单个单元格值的传递来说属于冗余的重操作，资源消耗远高于直接赋值
• 依赖当前激活单元格做偏移定位，一旦用户手动点选了Sheet2的其他位置，就会出现数据写错位的问题

优化后的代码完全跳过界面操作和剪贴板调用，直接通过对象引用完成值传递，同时自动定位写入位置，执行速度比原代码快数十倍，稳定性也更高：

Sub LogSingleValue()
    ' ------------ 可根据实际需求修改以下配置 ------------
    Const SOURCE_SHEET_NAME As String = "Sheet1"
    Const SOURCE_CELL_ADDR As String = "A1" ' 替换为你实际要采集的单元格地址
    Const TARGET_SHEET_NAME As String = "Sheet2"
    Const TARGET_COLUMN As Long = 1 ' 存储列号，1对应A列，2对应B列，以此类推
    ' ------------------------------------------------
    
    Dim sourceSht As Worksheet, targetSht As Worksheet
    Dim nextRow As Long
    
    ' 直接绑定工作表对象，无需切换选中工作表
    Set sourceSht = ThisWorkbook.Worksheets(SOURCE_SHEET_NAME)
    Set targetSht = ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
    
    ' 自动计算目标列下一个空行的行号
    nextRow = targetSht.Cells(targetSht.Rows.Count, TARGET_COLUMN).End(xlUp).Row + 1
    
    ' 直接传递值，不经过剪贴板，和xlPasteValues效果完全一致
    targetSht.Cells(nextRow, TARGET_COLUMN).Value = sourceSht.Range(SOURCE_CELL_ADDR).Value
End Sub

额外说明 #

• 代码把可配置项都放在了顶部常量区，后续你要调整采集单元格、存储位置的时候，直接修改顶部常量即可，不需要改动核心逻辑
• 因为全程没有选中切换工作表的操作，代码运行时用户在当前表的操作不会被打断，也不会出现屏幕闪跳的情况
• 如果你后续要对接5分钟定时触发逻辑，直接调用这个宏即可，不需要修改核心的取值、存值逻辑

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