将多个工作簿复制并粘贴到一个工作簿中

Question

我正在尝试编写一个代码，该代码将从文件的所有工作簿中复制和粘贴一些分散的单元格值，并将所有信息粘贴到一个电子表格中。我收到一条消息错误回复说：“运行时错误‘1004’：抱歉，我们找不到 D:\TESTES\05 MAIO\0335-2021- DEPEN - MINISTRIO DA SEGURANCA PUBLICA DF - ITEM 3 - SEDAN - 109 UND.XLSX。它是否可能被移动、重命名或删除？”

error message

这是我正在编写的代码：

Sub Find_Files()
        
    Dim wb As Workbook
    Dim fldr As FileDialog
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    fldr.Show
    f = fldr.SelectedItems(1)
    f = f & "\"
    
    ibox = InputBox("File Must Contain (Note * wildcards can be used)", , "*.xlsx*")
    'On Error GoTo ext
    
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & ibox & """ /s /a /b").stdout.readall, vbCrLf)
     
    files.Cells.Clear
    files.Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)



oarray = files.Cells(1, 1).CurrentRegion
rprw = kpi.Cells(1, 1).CurrentRegion.Rows.Count + 1

For rw = LBound(oarray) To UBound(oarray)
    Debug.Print oarray(rw, 1)
    Set wb = Workbooks.Open(oarray(rw, 1))
    kpi.Cells(rprw, 1) = wb.Sheets(1).Range("C3")
    kpi.Cells(rprw, 2) = wb.Sheets(1).Range("C4")
    kpi.Cells(rprw, 3) = wb.Sheets(1).Range("C5")
    kpi.Cells(rprw, 4) = wb.Sheets(1).Range("C6")
    kpi.Cells(rprw, 5) = wb.Sheets(1).Range("C7")
    kpi.Cells(rprw, 6) = wb.Sheets(1).Range("C8")
    kpi.Cells(rprw, 7) = wb.Sheets(1).Range("g3")
    kpi.Cells(rprw, 8) = wb.Sheets(1).Range("c12")
    kpi.Cells(rprw, 9) = wb.Sheets(1).Range("d12")
    kpi.Cells(rprw, 10) = wb.Sheets(1).Range("e12")
    kpi.Cells(rprw, 11) = wb.Sheets(1).Range("f12")
    kpi.Cells(rprw, 12) = wb.Sheets(1).Range("H12")
    kpi.Cells(rprw, 13) = wb.Sheets(1).Range("I12")
    kpi.Cells(rprw, 14) = wb.Sheets(1).Range("j12")
    kpi.Cells(rprw, 15) = wb.Sheets(1).Range("L12")
    wb.Close
    rprw = rprw + 1
Next

ext:

Set wb = Workbooks.Open(oarray(rw, 1))

End Sub

这是它们应该粘贴到的位置：

Excel Workbook

我不知道为什么它说找不到文件。