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