Скопировать отфильтрованные данные в другую книгу

Question

Я пытаюсь скопировать отфильтрованные данные в другую книгу и выдает ошибку времени выполнения '1004'.

Sub DS()
'
' DS Macro
'
    Dim wb As Workbook

    Set wb = Workbooks.Open("H:\L\Roy\H AND E\2020\SAP - 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:\L\Roy\H AND E\2020\SAP - 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:\L\Roy\RT\Transfers\Transfers 2020 - Roy.xlsm"
    targetWorkbookPath = "H:\L\Roy\H and E\2020\SAP - 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

Дайте мне знать, если это работает