Excel VBA复制粘贴宏间歇性跳过指定列问题求助

核心问题 #

你的宏出现间歇性复制跳过的原因主要有三点：

1. 目标范围按列单独计算起始行：使用End(xlDown)逐列计算目标起始行时，若某列数据行数不一致或存在空值，会导致起始行错位；加上On Error Resume Next的错误屏蔽，会让无效的范围设置被隐藏，最终导致复制操作静默失败。
2. 源范围引用未完全限定：设置源范围时，内部的Range("X2").End(xlDown)未指定工作表，虽然当前代码中ActiveSheet是源工作表，但存在潜在的引用错误风险。
3. 过度依赖错误屏蔽：On Error Resume Next掩盖了范围设置时的错误，无法及时定位问题根源。

修复后的代码 #

Sub DataCopy()
'
'DataTemplate Macro
'Will copy/paste the data from the Data file into the appropriate columns.
'
'Keyboard Shortcut: Ctrl+e
'

' 删除空行（保留原有逻辑）
On Error Resume Next
ActiveSheet.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

' 重命名源工作表（保留原有逻辑）
With ActiveSheet
    .Name = "Sheet1"
End With

' 声明变量
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim lastRowSource As Long
Dim lastRowTarget As Long
' 定义源列与目标列的映射关系
Dim columnMappings As Variant

' 初始化工作表引用
Set SourceSheet = ActiveWorkbook.Worksheets("Sheet1")
Set TargetSheet = Workbooks("DataTarget.xls").Worksheets("Sheet1")

' 获取源工作表最后一行（统一计算，避免逐列差异）
lastRowSource = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row
' 获取目标工作表最后一行（统一计算，确保所有列从同一行开始粘贴）
lastRowTarget = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row
' 如果目标表只有表头，起始行设为2；否则设为最后一行+1
If lastRowTarget = 1 Then
    lastRowTarget = 2
Else
    lastRowTarget = lastRowTarget + 1
End If

' 定义源列到目标列的映射：数组元素为(源列字母, 目标列字母)
columnMappings = Array( _
    Array("A", "A"), _
    Array("B", "H"), _
    Array("C", "G"), _
    Array("D", "B"), _
    Array("E", "J"), _
    Array("F", "K"), _
    Array("G", "L"), _
    Array("H", "I"), _
    Array("I", "O"), _
    Array("J", "Q"), _
    Array("K", "N") _
)

' 批量复制数据
Dim mapping As Variant
For Each mapping In columnMappings
    Dim sourceRange As Range
    Dim targetRange As Range
    Set sourceRange = SourceSheet.Range(mapping(0) & "2:" & mapping(0) & lastRowSource)
    Set targetRange = TargetSheet.Range(mapping(1) & lastRowTarget)
    sourceRange.Copy targetRange
Next mapping

' 填充E列（保留原有逻辑）
Dim k As Long, m As Long
k = TargetSheet.Cells(TargetSheet.Rows.Count, "B").End(xlUp).Row
m = TargetSheet.Cells(TargetSheet.Rows.Count, "E").End(xlUp).Row

If m < k Then
    TargetSheet.Range("E" & m).Copy TargetSheet.Range("E" & m & ":E" & k)
End If

' 清理资源
Set SourceSheet = Nothing
Set TargetSheet = Nothing
Application.CutCopyMode = False

MsgBox "数据复制完成！"
End Sub

关键修改说明 #

1. 统一计算最后一行：
   • 源工作表：通过Cells(Rows.Count, "A").End(xlUp)获取A列最后一行（假设A列无空值，若需更准确可使用UsedRange或Find方法）。
   • 目标工作表：统一计算整个表的最后一行，确保所有列从同一行开始粘贴，避免逐列计算的错位问题。
2. 使用列映射数组：
   • 将源列与目标列的对应关系存入数组，通过循环批量复制，减少重复代码，避免手动设置11组变量的错误。
3. 完全限定范围引用：
   • 所有Range对象均指定所属工作表，彻底避免跨工作表引用错误。
4. 移除不必要的错误屏蔽：
   • 仅保留删除空行时的错误屏蔽，其余部分取消错误屏蔽，便于排查潜在问题。
5. 简化资源清理：
   • 不再需要逐个清理11组范围变量，通过清理工作表引用即可释放资源。

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