Excel VBA复制特定列功能失效求助（原代码适配行正常）

看起来你的代码逻辑本身是对的——要跳过每3列中的第3列（也就是保留第1、2、4、5、7、8…列）复制到目标工作表，但复制列时出问题，大概率是逐列复制5000列的效率太低，导致Excel假死，让你误以为代码无法正常工作（毕竟复制行的时候，行数通常不会这么多，所以没触发这个问题）。

下面给你两个优化方案，从根源解决这个问题：

方案1：优化逐列复制的效率 #

通过关闭Excel的屏幕刷新和事件触发，减少不必要的资源消耗，同时定期释放系统资源避免假死：

Sub CopyColumnsSkippingEveryThird()
    Dim k As Integer, z As Integer
    Dim sourceSht As Worksheet
    Dim destSht As Worksheet
    
    ' 先关闭屏幕更新和事件，大幅提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    z = 0
    ' 明确指定工作簿，避免引用错误
    Set sourceSht = ThisWorkbook.Sheets("Sheet1")
    Set destSht = ThisWorkbook.Sheets("Sheet2")
    
    ' 可选：清空目标工作表原有数据，防止干扰
    destSht.Cells.Clear
    
    For k = 1 To 5000
        If k < 3 Or (k - 1) Mod 3 <> 0 Then
            z = z + 1
            sourceSht.Columns(k).Copy destSht.Columns(z)
        End If
        ' 每处理100列就释放一次资源，避免Excel假死
        If k Mod 100 = 0 Then DoEvents
    Next k
    
    ' 恢复Excel的默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "列复制完成！", vbInformation
End Sub

方案2：批量复制（推荐） #

把所有需要复制的列先合并成一个范围，然后一次性复制，操作次数从5000次降到1次，效率提升非常明显：

Sub BatchCopyColumns()
    Dim sourceSht As Worksheet
    Dim destSht As Worksheet
    Dim copyRange As Range
    Dim k As Integer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set sourceSht = ThisWorkbook.Sheets("Sheet1")
    Set destSht = ThisWorkbook.Sheets("Sheet2")
    destSht.Cells.Clear
    
    ' 构建需要复制的列范围
    For k = 1 To 5000
        If k < 3 Or (k - 1) Mod 3 <> 0 Then
            If copyRange Is Nothing Then
                Set copyRange = sourceSht.Columns(k)
            Else
                ' 合并多个列到同一个范围
                Set copyRange = Union(copyRange, sourceSht.Columns(k))
            End If
        End If
    Next k
    
    ' 一次性复制所有列到目标表的起始位置
    If Not copyRange Is Nothing Then
        copyRange.Copy destSht.Columns(1)
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    MsgBox "批量列复制完成！", vbInformation
End Sub

为什么原代码行复制正常？ #

因为复制行时，通常不会一次性处理5000行这么多（或者行复制的内存占用更低），所以逐行操作的效率问题没暴露出来；但列复制时，整列包含的单元格数量极大（Excel最多有1048576行），逐列复制会反复触发Excel的内部操作，导致卡顿甚至假死。

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