VBA报错：Select Method of Class Range Failed(Error1004)及数据覆盖问题咨询

嗨，我来帮你搞定这两个困扰你的问题——先解决那个Select Method of Class Range Failed (Error 1004)错误，再实现从空行粘贴避免覆盖已有数据的需求！

1. 解决1004错误：告别Select/Activate，直接引用对象 #

你遇到的1004错误，主要原因是过度依赖Select和Activate方法，这类方法很容易因为工作表状态（比如未激活、被保护）或路径/文件名处理问题失效。另外，你获取文件名的代码有小问题（Split(strPath, "\\")是多余的双斜杠），也可能导致激活窗口时出错。

优化思路：

• 直接用Workbooks.Open返回的对象赋值给wb2，不需要额外激活窗口
• 完全移除Select和Activate，通过工作簿+工作表对象直接操作单元格范围
• 修正文件名获取的逻辑

2. 实现从空行粘贴：定位最后非空行 #

要避免覆盖wb1已有数据，关键是找到File2工作表中A列最后一个有数据的行，然后从它的下一行开始粘贴。用Cells(Rows.Count, "A").End(xlUp).Row可以精准定位最后非空行，再加1就是空行起始位置。

修改后的完整代码 #

Private Sub Transferdata_Click()
    Dim intChoice As Integer
    Dim strPath As String
    Dim filname As String
    Dim wb1 As Workbook ' 接收数据的工作簿
    Dim wb2 As Workbook ' 提供数据的工作簿
    Dim copyRange As Range ' 要复制的范围
    Dim pasteStartRow As Long ' 粘贴的起始行
    
    Set wb1 = ActiveWorkbook
    MsgBox "Please open the workbook you need to transfer the data from"
    
    ' 重置文件对话框过滤器
    Application.FileDialog(msoFileDialogOpen).Filters.Clear
    intChoice = Application.FileDialog(msoFileDialogOpen).Show
    
    If intChoice <> 0 Then
        strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        ' 修正文件名获取逻辑：用单斜杠分割
        filname = Split(strPath, "\")(UBound(Split(strPath, "\")))
        
        Application.ScreenUpdating = False
        
        ' 直接打开工作簿并赋值给wb2，无需激活
        Set wb2 = Workbooks.Open(Filename:=strPath)
        
        ' 直接定义要复制的范围，避免Select
        With wb2.Sheets("File")
            ' 如果A3下面没有数据，End(xlDown)会跳到最后一行，这里加个判断
            If .Range("A3").Value <> "" Then
                Set copyRange = .Range("A3", .Range("A3").End(xlDown))
                ' 可选：如果要复制整行数据，改成 .Range("A3", .Range("A3").End(xlDown).EntireRow)
            Else
                MsgBox "wb2的File工作表A3位置没有数据，无法复制！"
                wb2.Close SaveChanges:=False
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End With
        
        ' 定位wb1中File2工作表的空行起始位置
        With wb1.Sheets("File2")
            ' 如果A列没有数据，默认从A4开始；否则从最后非空行的下一行开始
            If .Range("A4").Value = "" Then
                pasteStartRow = 4
            Else
                pasteStartRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            End If
        End With
        
        ' 直接粘贴值，无需Select/Activate
        copyRange.Copy
        wb1.Sheets("File2").Cells(pasteStartRow, "A").PasteSpecial Paste:=xlPasteValues
        
        ' 关闭wb2，不保存（如果需要保存可以改成SaveChanges:=True）
        wb2.Close SaveChanges:=False
        Application.CutCopyMode = False ' 清除复制模式
        Application.ScreenUpdating = True
        
        MsgBox "数据传输完成！"
    End If
End Sub

关键优化点说明 #

• 移除Select/Activate：直接通过wb2.Sheets("File")和wb1.Sheets("File2")操作单元格，避免了激活窗口带来的不稳定
• 空行定位逻辑：兼顾了File2工作表A4为空（首次粘贴）和已有数据（后续粘贴）的两种情况
• 增加异常判断：如果wb2的A3没有数据，会弹出提示并终止流程，避免后续错误
• 修正文件名获取：把Split(strPath, "\\")改成Split(strPath, "\")，符合Windows路径的分割规则

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