将筛选的数据复制到另一个工作簿

Question

我正试图将筛选后的数据复制到另一个工作簿，但它给了我运行时错误"1004"。

Sub DS()
'
' DS Macro
'
Dim wb As Workbook
Set wb = Workbooks.Open("H:LRoyH AND E2020SAP - ZPSD02_template2")
'
'Selection.AutoFilter
Worksheets("ST TO ST").Range("$A$1:$O$1").AutoFilter Field:=12, Criteria1:="PENDING"
lastRow = Worksheets("ST TO ST").Range("J" & Worksheets("ST TO ST").Rows.Count).End(xlUp).Row
'ActiveWindow.SmallScroll Down:=-12
Worksheets("ST TO ST").Range("$A$1:$O$1").AutoFilter Field:=10, Criteria1:="U3R", Operator:=xlOr, Criteria2:="U2R"
Worksheets("ST TO ST").Range("J2:J" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=wb.Sheets("Sheet1").Range("A1")
Worksheets("ST TO ST").Range("C2:C" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=wb.Sheets("Sheet1").Range("B1")
Worksheets("ST TO ST").Range("D2:D" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=wb.Sheets("Sheet1").Range("E1")
Worksheets("ST TO ST").Range("H2:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=wb.Sheets("Sheet1").Range("F1")
End Sub

Answer 1

请注意，您的工作簿路径指向一个文件夹，您需要将其指向一个文件。

编辑：如您的评论所述

targetWorkbookPath = "H:LRoyH AND E2020SAP - ZPSD02_template2.xlsx"(或xlsm(

检查代码的注释并根据您的需求进行调整

编辑2:采用您在编辑中添加的路径，并将它们合并到代码中。

代码：

Sub DS()
Dim sourceWorkook As Workbook
Dim targetWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim sourceWorkbookPath As String
Dim targetWorkbookPath As String
Dim lastRow As Long

' Define workbooks paths
sourceWorkbookPath = "H:LRoyRTTransfersTransfers 2020 - Roy.xlsm"
targetWorkbookPath = "H:LRoyH and E2020SAP - ZPSD02_template2.xlsx"
' Set a reference to the target Workbook and sheets
Set sourceWorkbook = Workbooks.Open(sourceWorkbookPath)
Set targetWorkbook = Workbooks.Open(targetWorkbookPath)
' definr worksheet's names for each workbook
Set sourceSheet = sourceWorkbook.Worksheets("ST TO ST")
Set targetSheet = targetWorkbook.Worksheets("Sheet1")
With sourceSheet
' Get last row
lastRow = .Range("J" & .Rows.Count).End(xlUp).Row
.Range("A1:O1").AutoFilter Field:=12, Criteria1:="PENDING"
.Range("A1:O1").AutoFilter Field:=10, Criteria1:="U3R", Operator:=xlOr, Criteria2:="U2R"
.Range("J2:J" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=targetSheet.Range("A1")
.Range("C2:C" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=targetSheet.Range("B1")
.Range("D2:D" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=targetSheet.Range("E1")
.Range("H2:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=targetSheet.Range("F1")
End With
End Sub

让我知道它是否有效