VBA跨工作簿复制筛选数据触发对象不支持属性错误求助

直接报错原因 #

错误行 Workbooks("Test2.xlsx").Worksheets("Overdue").Range("A1").Paste 触发异常的核心是：VBA 中Range对象没有Paste方法，粘贴动作是Worksheet对象的方法，你可以用两种方式修改：

• 调用工作表Paste方法，指定粘贴目标单元格：Workbooks("Test2.xlsx").Worksheets("Overdue").Paste Destination:=Range("A1")
• 直接使用Range的PasteSpecial方法完成粘贴

其他潜在问题 #

你的代码还存在几个容易触发异常的隐患：

1. 操作对象未显式声明归属，默认依赖活动工作簿/活动工作表，很容易出现范围匹配错误
2. 复制完数据后执行了新建工作簿、保存等操作，可能会清空剪贴板导致粘贴内容丢失
3. 路径写法缺少分隔符，C:test1.xlsx属于非法路径，实际使用需要补全\
4. 代码执行完没有恢复ScreenUpdating、DisplayAlerts的默认状态，会影响后续Excel操作

修正后完整代码 #

Sub Save()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 生成第一个工作簿
    Dim wb As Workbook
    Set wb = Workbooks.Add
    ThisWorkbook.Sheets("Due_Date_Approaching").Copy Before:=wb.Sheets(1)
    ThisWorkbook.Sheets("Overdue").Copy Before:=wb.Sheets(1)
    wb.Sheets(2).Name = "Due Date Approaching"
    wb.Sheets("Sheet1").Delete
    ' 实际使用替换为你自己的真实保存路径
    wb.SaveAs "C:\test1.xlsx"
    wb.Close SaveChanges:=False
    
    ' 提前生成第二个目标工作簿，避免复制后操作清空剪贴板
    Dim APAC As Workbook
    Set APAC = Workbooks.Add
    APAC.Worksheets.Add Count:=2
    APAC.Sheets(1).Name = "Overdue"
    APAC.Sheets(2).Name = "Due Date Approaching"
    APAC.Sheets("Sheet1").Delete
    
    ' 对原工作簿的Overdue表做筛选
    ThisWorkbook.Worksheets("Overdue").Range("A1").AutoFilter Field:=35, Criteria1:="ASIA"
    ' 复制筛选后的可见区域
    ThisWorkbook.Worksheets("Overdue").UsedRange.Copy
    
    ' 直接粘贴到目标工作表，不会再触发错误
    APAC.Worksheets("Overdue").Range("A1").PasteSpecial Paste:=xlPasteAll
    
    ' 清除原表筛选状态
    ThisWorkbook.Worksheets("Overdue").AutoFilterMode = False
    ' 保存第二个工作簿，实际替换为真实路径
    APAC.SaveAs "C:\Test2.xlsx"
    APAC.Close SaveChanges:=False
    
    ' 恢复Excel默认设置
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

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