将数据复制到新工作簿时，如何在同一目录中的多个工作簿中循环遍历 Excel 工作表？

Question

This code by itself would loop through workbooks in a directory and copy data from specific cells on the first sheet to a new workbook. I would like to have it do that, but also go through each worksheet in each workbook to get the required data.

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

This gives me the error:

Runtime Error 1004, Application defined or Object defined error.

Previous versions of the code I have tried have done the following:

• Did not copy any data at all (using a "For each ws" statement)
• Error "Loop without Do" (using a for statement with counter)
• General compilations errors.

Answer 1

The construct you need is:

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

Also, and this is a tangent but I'll drop it here just to illustrate some possible point of confusion -- have a look at the several ways of iterating/looping in 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