將數據復制到新工作簿時，如何在同一目錄中的多個工作簿中循環遍歷 Excel 工作表？

Question

此代碼本身將遍歷目錄中的工作簿，並將數據從第一張工作表上的特定單元格復制到新工作簿。 我想讓它這樣做，但也要瀏覽每個工作簿中的每個工作表以獲取所需的數據。

Sub GatherData()

    Dim wkbkorigin As Workbook
    Dim originsheet As Worksheet
    Dim destsheet As Worksheet
    Dim ResultRow As Long
    Dim Fname As String
    Dim RngDest As Range
    Dim ws As Worksheet

    Set destsheet = ThisWorkbook.Worksheets("Sheet1")
    Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp) _
                       .Offset(1, 0).EntireRow
    Fname = Dir(ThisWorkbook.Path & "/*.xlsm")

    'loop through each file in folder (excluding this one)
    Do While Fname <> "" And Fname <> ThisWorkbook.Name

            Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)
            'Set originsheet = wkbkorigin.Worksheets("1st")
            For Each ws In wkbkorigin
            With ws
                RngDest.Cells(1).Value = .Range("D3").Value
                RngDest.Cells(2).Value = .Range("E9").Value
                '.Cells(3).Value = originsheet.Range("D22").Value
                '.Cells(4).Value = originsheet.Range("E11").Value
                '.Cells(5).Value = originsheet.Range("F27").Value
            End With
            Next
            wkbkorigin.Close SaveChanges:=False   'close current file
            Set RngDest = RngDest.Offset(1, 0)
            Fname = Dir()     'get next file
    Loop
End Sub

這給了我錯誤：

運行時錯誤 1004、應用程序定義或對象定義錯誤。

我嘗試過的以前版本的代碼執行了以下操作：

• 根本沒有復制任何數據（使用“For each ws”語句）
• 錯誤“Loop without Do”（使用帶計數器的 for 語句）
• 一般編譯錯誤。

Answer 1

您需要的構造是：

Do While Fname <> "" And Fname <> ThisWorkbook.Name
    Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)
    For Each ws in wkbkorigin.Worksheets '### YOU NEED TO ITERATE OVER SHEETS IN THE WORKBOOK THAT YOU JUST OPENED ON THE PRECEDING LINE
        With ws
            ' Do something with the ws Worksheet, like take the values from D3 and E9 and put them in your RngDest range:
             RngDest.Cells(1,1).Value = .Range("D3").Value
             RngDest.Cells(1,2).Value = .Range("E9").Value
        End With
        Set RngDest = RngDest.Offset(1, 0) '## Offset this range for each sheet so that each sheet goes in a new row
    Next
    wkbkorigin.Close SaveChanges:=False   'close current file
    Fname = Dir()     'get next file
Loop

另外，這是一個切線，但我將它放在這里只是為了說明一些可能的混淆點——看看在 VBA 中迭代/循環的幾種方法：

Sub testing()
Dim i As Long
i = 0

'## do Loop can have a condition as part of the Loop
Do
    Call printVal(i)
Loop While i < 10

'## Or as part of the Do
Do While i < 20
    Call printVal(i)
Loop

'## You can use Do Until (or Do While) as above
Do Until i >= 30
    Call printVal(i)
Loop

'## Likewise, Loop Until (or Loop While)
Do
    Call printVal(i)
Loop Until i >= 40

'## You don't even need to include a CONDITION if you Exit Do from within the loop!
Do
    Call printVal(i)
    If i >= 50 Then Exit Do
Loop

'## Or you can use While/Wend
While i < 60
    Call printVal(i)
Wend

'## For/Next may also be appropriate:
For i = 60 To 70
    Call printVal(i)
Next


End Sub
Sub printVal(ByRef i As Long)
    i = i + 1
    Debug.Print i
End Sub