嘿，我来帮你解决这个代码耗时的问题！你的代码逻辑是对的，但复制粘贴操作依赖剪贴板，本身就比较慢，再加上反复调用，自然会拖慢速度。咱们换一种更高效的方式，直接跳过剪贴板，把单元格的值直接赋值过去，速度能提升一大截！

原代码的几个小问题 #

• 你重复多次设置Application.ScreenUpdating = False，其实只需要在代码开头设置一次，结尾恢复就够了
• 每次Copy/PasteSpecial都要和系统剪贴板交互，这是耗时的核心原因

优化后的代码方案 #

直接通过单元格的.Value属性赋值，这是VBA里最快的批量数据操作方式之一。另外，我们还可以关闭更多Excel的后台功能，进一步提速：

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim copyPairs As Variant
    Dim i As Long
    
    ' 提前定义工作表，避免重复引用
    Set ws = ThisWorkbook.Sheets("Session")
    
    ' 关闭Excel的后台耗时功能
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    ' 整理源列和目标列的对应关系，更清晰易维护
    copyPairs = Array( _
        Array("A1:A2000", "Y1, AF1, CW1"), _
        Array("B1:B2000", "AB1, AC1"), _
        Array("V1:V2000", "BG1, BS1, CA1"), _
        Array("G5:G2000", "BA1, BC1, BE1"), _
        Array("T1:T2000", "DI1"), _
        Array("X1:x2000", "CX1") _
    )
    
    ' 循环处理每一组复制需求
    For i = LBound(copyPairs) To UBound(copyPairs)
        Dim sourceRange As Range
        Dim targetAreas As Areas
        
        Set sourceRange = ws.Range(copyPairs(i)(0))
        Set targetAreas = ws.Range(copyPairs(i)(1)).Areas
        
        ' 给每个目标区域赋值
        Dim area As Range
        For Each area In targetAreas
            ' 如果源区域和目标区域行数一致，直接赋值
            If area.Rows.Count = sourceRange.Rows.Count Then
                area.Value = sourceRange.Value
            Else
                ' 处理像G5:G2000这种非从第1行开始的情况，确保行数匹配
                area.Resize(sourceRange.Rows.Count).Value = sourceRange.Value
            End If
        Next area
    Next i
    
    ' 恢复Excel的正常设置
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "数据复制完成！", vbInformation
End Sub

提速关键要点 #

• 直接赋值替代复制粘贴：area.Value = sourceRange.Value完全跳过剪贴板，速度比Copy/PasteSpecial快几倍甚至十几倍
• 批量管理设置：一次性关闭ScreenUpdating、Calculation、EnableEvents，避免这些后台操作拖慢代码
• 结构化的对应关系：用数组整理源列和目标列，后续修改或新增需求时更方便，也减少重复代码
• 处理非连续区域：通过Areas属性拆分多个目标列，逐个赋值，确保数据对应正确

这个优化后的代码应该能把执行时间压缩到1秒以内，你可以试试！

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