Question

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

使用下面的宏我试图找到那些帐户（符合标准＆＃34;在范围＆＃34;例如帐户12345678），复制它们，以搜索相同的文件夹（ThisWorkbook所在的地方），找到另一个excel文件，其中包含帐号的名称（例如＆＃34; 12345678.xlsx＆＃34;）并打开它。

在下面的建议更正后，我的宏找到并打开所需的文件。但现在问题是不能对它执行任何操作：复制，粘贴等。

你能帮忙吗？

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

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

1 个答案: