Excel 2013無法在ThisWorkbook目錄中找到並打開文件

Question

以下是我發生的問題。我使用MS Excel 2013.

使用下面的宏，我試圖找到那些帳戶（符合條件「範圍內」，例如帳戶12345678），複製它們以搜索相同的文件夾（其中ThisWorkbook是） ，找到另一個excel文件，其名稱爲賬戶號碼（例如「12345678.xlsx」）並將其打開。

在下面提出的更正後，我的宏查找並打開所需的文件。但現在的問題是，無法對其執行任何操作：複製，粘貼等。

請問您可以幫忙嗎？

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