Excel VBA运行时错误1004：复制粘贴区域大小不匹配问题

核心问题分析 #

• 重复粘贴到同一位置：你的代码每次循环都把整行数据粘贴到Result表的W1单元格，第一次粘贴后该区域已被占用，后续粘贴时复制的整行区域与目标区域大小不兼容，直接触发1004错误。
• 未处理边界情况：如果遍历到数据末尾仍未找到结束标记，startrow未被初始化，复制的区域会无效。
• 依赖活动对象：使用Select、ActiveSheet这类方法容易因工作表切换、选中状态变化引发意外错误。

修复后的代码 #

Sub exportconditionstarttoend()
    Dim sourceSheet As Worksheet
    Dim resultSheet As Worksheet
    Dim startrow As Long
    Dim endrow As Long
    Dim lastrow As Long
    Dim rownum As Long
    Dim nextPasteRow As Long ' 记录下一次粘贴的起始行
    
    ' 初始化工作表对象，避免使用Select/Active
    Set sourceSheet = ThisWorkbook.Worksheets("ETM ETM0007")
    Set resultSheet = ThisWorkbook.Worksheets("Result")
    
    ' 获取W列最后一行数据
    lastrow = sourceSheet.Range("W" & sourceSheet.Rows.Count).End(xlUp).Row
    nextPasteRow = 1 ' 初始粘贴到Result表的第1行
    
    rownum = 1
    Do While rownum <= lastrow
        ' 查找起始标记
        Do While rownum <= lastrow
            If sourceSheet.Cells(rownum, "W").Value = "Condition 1 - Price 0.25" Then
                startrow = rownum
                Exit Do
            End If
            rownum = rownum + 1
        Loop
        
        ' 如果没找到起始标记，退出循环
        If rownum > lastrow Then Exit Do
        
        ' 查找结束标记
        rownum = rownum + 1
        Do While rownum <= lastrow
            If sourceSheet.Cells(rownum, "W").Value = "Condition 1 - Price 0.25 - End" Then
                endrow = rownum
                Exit Do
            End If
            rownum = rownum + 1
        Loop
        
        ' 如果找到结束标记，复制粘贴
        If rownum <= lastrow Then
            ' 复制起始到结束的整行
            sourceSheet.Rows(startrow & ":" & endrow).Copy
            ' 粘贴到Result表的nextPasteRow行，无需Select
            resultSheet.Rows(nextPasteRow).PasteSpecial xlPasteAll
            
            ' 更新下一次粘贴的起始行（跳过已粘贴的行数）
            nextPasteRow = nextPasteRow + (endrow - startrow + 1)
            
            rownum = rownum + 1
        Else
            ' 未找到结束标记，退出循环
            Exit Do
        End If
    Loop
    
    ' 清除剪贴板
    Application.CutCopyMode = False
End Sub

关键修复点说明 #

• 消除活动对象依赖：直接引用工作表对象sourceSheet和resultSheet，不再使用Select和ActiveSheet，彻底避免状态变化引发的错误。
• 动态更新粘贴位置：用nextPasteRow记录下一次粘贴的起始行，每次粘贴后自动更新，确保数据不重叠，区域大小完全匹配。
• 增加边界处理：补充了未找到起始/结束标记时的退出逻辑，避免无效复制操作。
• 优化整行操作：直接使用Rows对象复制整行，粘贴到目标表对应行，确保复制粘贴的区域大小完全一致。

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