将数据复制到新工作簿时，如何在同一目录中的多个工作簿中循环遍历 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