如何修复跨工作簿复制数据的VBA“应用程序定义或对象定义错误”

原错误原因（应用程序定义或对象定义错误） #

触发错误的代码行：

Set blankCell = dataSheet.Range("B" & lastRowB + 1).End(xlDown).Offset(1)

当B&lastRowB+1单元格下方无任何数据时，End(xlDown)会直接跳到工作表最后一行（第1048576行），此时Offset(1)会超出工作表行范围，触发越界错误。

修改后新问题的原因 #

改为Set blankCell = dataSheet.Range("B" & lastRowB + 1)后，忽略新插入行的B列空白单元格，核心问题有两个：

1. 插入行逻辑错误：原代码仅插入1行，但copyRange可能包含多行数据，导致直接覆盖原有行而非插入对应行数的新行，新行的B列空白状态未被正确识别。
2. B列起始空白单元格计算时机错误：lastRowB是在插入新行之前计算的，插入行后B列的空白起始位置应与新插入数据的起始行对齐，而非沿用旧值。

完整修复后的代码 #

Sub CopyDataFromFiles()
    Dim filePath1 As String
    Dim filePath2 As String
    Dim file1 As Workbook
    Dim file2 As Workbook
    Dim summarySheet As Worksheet
    Dim dataSheet As Worksheet
    Dim lastRowC As Long ' 记录C列最后非空行
    Dim copyRange As Range
    Dim pasteRange As Range
    Dim copyRowsCount As Long ' 复制数据的行数
    Dim firstBlankRowB As Long ' B列第一个空白行
    
    ' 设置文件路径
    filePath1 = "C:\Users\User\Documents\Test Reports\Test_Report_Master.xlsx"
    filePath2 = GetLastModifiedFile("C:\Users\User\Documents\Test Reports\Daily Reports")
    
    ' 打开工作簿
    Set file1 = Workbooks.Open(filePath1)
    Set file2 = Workbooks.Open(filePath2)
    
    ' 指定工作表
    Set summarySheet = file2.Sheets("Summary")
    Set dataSheet = file1.Sheets("Data")
    
    ' 获取文件2中需要复制的数据范围
    Set copyRange = summarySheet.Range("A5:B" & summarySheet.Cells(summarySheet.Rows.Count, "A").End(xlUp).Row)
    copyRowsCount = copyRange.Rows.Count ' 获取复制数据的行数
    
    ' 获取文件1中C列最后非空行
    lastRowC = dataSheet.Cells(dataSheet.Rows.Count, "C").End(xlUp).Row
    
    ' 插入对应行数的新行（在C列最后一行下方）
    If copyRowsCount > 0 Then
        dataSheet.Rows(lastRowC + 1 & ":" & lastRowC + copyRowsCount).Insert xlShiftDown
    End If
    
    ' 将复制的数据粘贴到C、D列
    Set pasteRange = dataSheet.Range("C" & lastRowC + 1)
    pasteRange.Resize(copyRowsCount, copyRange.Columns.Count).Value = copyRange.Value
    
    ' 获取B列第一个空白行（插入新行后重新计算）
    firstBlankRowB = dataSheet.Cells(dataSheet.Rows.Count, "B").End(xlUp).Row + 1
    
    ' 填充B4的值到B列所有空白单元格（从第一个空白行到C列最后数据行）
    Dim lastDataRow As Long
    lastDataRow = dataSheet.Cells(dataSheet.Rows.Count, "C").End(xlUp).Row
    
    If firstBlankRowB <= lastDataRow Then
        dataSheet.Range("B" & firstBlankRowB & ":B" & lastDataRow).Value = summarySheet.Range("B4").Value
    End If
    
    ' 保存并关闭工作簿
    file1.Close SaveChanges:=True
    file2.Close SaveChanges:=False
End Sub

Function GetLastModifiedFile(folderPath As String) As String
    Dim lastModifiedFile As String
    Dim lastModifiedDate As Date
    Dim fileName As String
    Dim fileDate As Date
    
    lastModifiedDate = DateSerial(1900, 1, 1)
    fileName = Dir(folderPath & "\*.xlsx")
    
    Do While fileName <> ""
        fileDate = FileDateTime(folderPath & "\" & fileName)
        If fileDate > lastModifiedDate Then
            lastModifiedDate = fileDate
            lastModifiedFile = folderPath & "\" & fileName
        End If
        fileName = Dir
    Loop
    
    GetLastModifiedFile = lastModifiedFile
End Function

关键修复点说明 #

• 插入对应行数的新行：根据copyRange的行数一次性插入足够的新行，避免覆盖原有数据，确保新插入行的B列处于空白状态。
• 重新计算B列起始空白行：在插入新行后再计算B列的第一个空白行，确保起始位置正确指向新插入行的B列。
• 精准填充范围：以C列最后非空行为基准确定B列填充的结束行，只填充数据区域内的空白单元格，避免无效填充到工作表末尾。

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