Excel 2013无法在ThisWorkbook目录中find并打开该文件

以下问题发生在我身上。 我使用MS Excel 2013。

使用下面的macros，我试图find那些帐户（符合条件“范围内”，例如帐户12345678），复制它们，以search相同的文件夹（其中ThisWorkbook是），find另一个Excel文件，账户号码（例如“12345678.xlsx”）并将其打开。

在下面提出的更正后，我的macrosfind并打开所需的文件。 但现在的问题是不能对其执行任何操作：复制，粘贴等。

你能帮忙吗？

Sub FileFinder() 'Excel variables: Dim RngS As Excel.Range Dim wbResults As Workbook 'Go to the column with specific text Worksheets("Accounts source data").Activate X = 3 Y = 25 While Not IsEmpty(Sheets("Accounts source data").Cells(X, Y)) Sheets("Accounts source data").Cells(X, Y).Select If ActiveCell = "In scope" Then Sheets("Accounts source data").Cells(X, Y - 22).Select 'Copy the account in scope Set RngS = Selection Selection.Copy 'Search, in same directory where the file is located, the file with that account (file comes with account number as name) sDir = Dir$(ThisWorkbook.Path & "\" & RngS & ".xlsx", vbNormal) Set oWB = Workbooks.Open(ThisWorkbook.Path & "\" & sDir) 'Here is where my error occurs '[Run-time error 5: Invalid procedure call or argument] Sheet2.Cells("B27:B30").Copy oWB.Close End If X = X + 1 Wend End Sub 

Answer 1

尝试下面的代码，我有我的解释和代码中的问题（作为commnets）：

 Option Explicit Sub FileFinder() ' Excel variables: Dim wbResults As Workbook Dim oWB As Workbook Dim Sht As Worksheet Dim RngS As Range Dim sDir As String Dim LastRow As Long Dim i As Long, Col As Long Col = 25 ' set ThisWorkbook object Set wbResults = ThisWorkbook ' set the worksheet object Set Sht = Worksheets("Accounts source data") With Sht ' find last row with data in Column "Y" (Col = 25) LastRow = .Cells(.Rows.Count, 25).End(xlUp).Row For i = 3 To LastRow If .Cells(i, Col) = "In scope" Then ' Set the range directly, no need to use `Select` and `Selection` Set RngS = .Cells(i, Col).Offset(, -22) ' Search, in same directory where the file is located, the file with that account (file comes with account number as name) sDir = Dir$(ThisWorkbook.Path & "\" & RngS.Value & ".xlsx", vbNormal) Set oWB = Workbooks.Open(ThisWorkbook.Path & "\" & sDir) oWB.Worksheets("Report").Range("B27:B30").Copy ' *** Paste in ThisWorkbook, in my exmaple "Sheet2" <-- modify to your needs wbResults.Worksheets("Sheet2").Range("C1").PasteSpecial Paste:=xlPasteAll, Transpose:=True oWB.Close SaveChanges:=False ' sDir = Dir$ ' clear objects Set RngS = Nothing Set oWB = Nothing End If Next i End With End Sub