VBA 将过滤后的数据从一个工作簿复制粘贴到另一个工作簿

Question

我被困在下面代码的最后一部分。基本上我需要从一个工作簿中过滤我的“wb”数据，然后将其粘贴到我创建的新工作簿中的选项卡中。除了将过滤后的数据复制到新的工作簿选项卡中之外，我什么都能做。任何帮助，将不胜感激。数据也是动态的，这就是我使用“UsedRange”的原因。出于隐私考虑，已对 SaveAs 路径进行了编辑。

Sub Save()
Application.ScreenUpdating = 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"
 Application.DisplayAlerts = False
wb.Sheets("Sheet1").Delete

wb.SaveAs "C:test1.xlsx"

Worksheets("Overdue").Activate
Worksheets("Overdue").Range("A1").AutoFilter Field:=35, Criteria1:="ASIA"
Worksheets("Overdue").UsedRange.Copy

Dim APAC As Workbook
Set APAC = Workbooks.Add
ActiveWorkbook.Worksheets.Add Count:=2
APAC.Sheets(1).Name = "Overdue"
APAC.Sheets(2).Name = "Due Date Approaching"
Application.DisplayAlerts = False
APAC.Sheets("Sheet1").Delete

APAC.SaveAs "C:Test2.xlsx"

'This is where it gives me "Object doesnt support this property or method"
Workbooks("Test2.xlsx").Worksheets("Overdue").Range("A1").Paste

Application.CutCopyMode = False


End Sub

Answer 1

它可能更漂亮，但在功能上我认为你错过了上面链接的重点。您很可能只想从过滤器中复制可见单元格，而无需在粘贴前清除剪贴板。像我在这里所做的那样使用CurrentRegion 假设您使用的是连续数据。如果不是，最好使用最后一行和最后一列声明范围。 这是一个修订：

Sub Save()

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    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"
    
    Dim APAC As Workbook
    Set APAC = Workbooks.Add
    ActiveWorkbook.Worksheets.Add Count:=2
    APAC.Sheets(1).Name = "Overdue"
    APAC.Sheets(2).Name = "Due Date Approaching"
    APAC.Sheets("Sheet1").Delete
    
    APAC.SaveAs "C:Test2.xlsx"
    
    ThisWorkbook.Worksheets("Overdue").Range("A1").CurrentRegion.AutoFilter Field:=35, Criteria1:="ASIA"
    ThisWorkbook.Worksheets("Overdue").Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
    Workbooks("Test2.xlsx").Worksheets("Overdue").Range("A1").PasteSpecial xlPasteAll
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
End Sub