基于列标题跨工作簿复制数据的VBA宏报错求助

错误根源分析 #

1. 遍历全列触发空列异常
   你当前代码通过For Each sourceColumn In sourceWS.Columns遍历工作表全部16384列，绝大多数列的第1行标题为空。此时Application.Match会返回错误，但On Error Resume Next跳过了错误判断，导致Set targetColumn执行失败，targetColumn变为Nothing，后续调用targetColumn.Offset(5, 0)时直接触发对象定义错误。

2. 整列复制的范围问题
   即便列有标题，sourceColumn.Rows.Count指向工作表总行数（如1048576行），Resize(sourceColumn.Rows.Count - 1, 1)会选中从第2行到最后一行的所有单元格，这个超大范围不仅效率极低，还可能因内存或空单元格问题引发错误。

修复方案与优化代码 #

Sub EquipmentTransfer()
    Dim sourceWB As Workbook, targetWB As Workbook
    Dim sourceWS As Worksheet, targetWS As Worksheet
    Dim sourceCol As Range, targetCol As Range
    Dim lastSourceCol As Long, lastSourceRow As Long
    Dim matchResult As Variant
    Dim headerText As String

    ' 绑定目标工作簿与工作表
    Set sourceWB = Workbooks("Memorial Hospital of South Bend Equipment List v0.2.xlsx")
    Set targetWB = Workbooks("Memorial Hospital Energy Model v0.1.xlsm")
    Set sourceWS = sourceWB.Sheets("Chillers")
    Set targetWS = targetWB.Sheets("16 - Electric Chillers")

    ' 获取源表第1行最后一个非空列，限制遍历范围
    lastSourceCol = sourceWS.Cells(1, sourceWS.Columns.Count).End(xlToLeft).Column

    ' 仅遍历存在标题的列
    For Each sourceCol In sourceWS.Range(sourceWS.Columns(1), sourceWS.Columns(lastSourceCol)).Columns
        headerText = sourceCol.Cells(1, 1).Value
        
        ' 跳过空标题列
        If headerText = "" Then GoTo NextCol

        ' 匹配目标表第5行的对应标题
        matchResult = Application.Match(headerText, targetWS.Rows(5), 0)
        
        ' 校验匹配结果有效性，确保targetCol对象存在
        If Not IsError(matchResult) Then
            Set targetCol = targetWS.Columns(matchResult)
            
            ' 获取源列最后一个非空行，仅复制有数据的区域
            lastSourceRow = sourceCol.Cells(sourceWS.Rows.Count, 1).End(xlUp).Row
            If lastSourceRow > 1 Then ' 确认存在数据行
                sourceCol.Range(sourceCol.Cells(2, 1), sourceCol.Cells(lastSourceRow, 1)).Copy
                ' 粘贴到目标列第6行（跳过前5行）
                targetCol.Cells(6, 1).PasteSpecial xlPasteValues
            End If
        End If
NextCol:
    Next sourceCol

    ' 释放剪贴板资源
    Application.CutCopyMode = False
End Sub

关键修复点说明 #

• 限制遍历范围：通过lastSourceCol获取源表有效标题列的边界，避免处理大量空列。
• 空标题过滤：直接跳过无标题的列，减少无效匹配操作。
• 明确对象校验：单独存储matchResult并校验有效性，确保targetCol不为空对象。
• 精准复制范围：仅复制源列中有数据的行，避免整列复制的性能问题和潜在错误。

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