如何解决Excel VBA复制数据时出现“粘贴区域不匹配”的报错？

• 报错核心原因是你复制的是完整B列（共1048576行），但粘贴位置是当前工作表已有数据末尾的下方，可容纳行数远小于1048576，两者行数不匹配触发“粘贴区域不一致”报错。
• 原有代码大量使用Select/ActiveCell这类依赖活动窗口的写法，容易因窗口焦点漂移出现逻辑异常，同时结尾没有恢复屏幕刷新，会导致Excel界面卡住。

Sub GetData2()
    Dim FileToOpen As Variant
    Dim openbook As Workbook
    Dim lastRow As Long
    Dim pasteStart As Range
    
    ChDrive "C"
    ChDir "C:\Users\alovell\Desktop\q400"
    Application.ScreenUpdating = False
    
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your file", FileFilter:="Excel Files(*.xls*),*xls*")
    If FileToOpen <> False Then
        Set openbook = Application.Workbooks.Open(FileToOpen)
        
        With openbook.Sheets(1)
            ' 删除A列空行
            .Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            ' 应用筛选规则
            .Range("A:D").AutoFilter Field:=2, Criteria1:="=fabricate*", Operator:=xlAnd, Criteria2:="<>*machine*"
            ' 定位B列最后一行有效数据，避免整列复制
            lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            ' 仅复制筛选后可见的有效数据（跳过表头）
            If lastRow > 1 Then ' 避免无符合条件数据时报错
                .Range("B2:B" & lastRow).SpecialCells(xlCellTypeVisible).Copy
                ' 定位粘贴起点
                Set pasteStart = ThisWorkbook.Sheets(3).Cells(ThisWorkbook.Sheets(3).Rows.Count, "A").End(xlUp).Offset(1, 0)
                pasteStart.PasteSpecial xlPasteValues
            End If
        End With
        
        ' 关闭打开的源文件，不需要保存修改可直接设为False
        openbook.Close SaveChanges:=False
    End If
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
End Sub

• 放弃整列复制逻辑，先动态计算源数据B列的最后有效行号，仅复制B2到最后有效行的筛选后可见内容，彻底解决复制区域过大的问题。
• 移除所有Select/ActiveCell依赖，直接通过工作表对象操作数据，避免窗口焦点变化导致的逻辑错误。
• 新增无符合筛选条件数据的判断逻辑，避免空复制场景下的报错。
• 补充了源文件关闭、屏幕刷新恢复的逻辑，避免操作后残留未关闭文件、Excel界面卡住的问题。

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