问题
So I have been working for a couple hours on how to get this existing code to function the way I want it to. 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. I would post all the versions of my data that I have tried but, I'm sure that will get me banned as well. So I will post my most recent:
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
So This current version 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.
I realize this question in part has been asked before, but I believe the question to be unique because, I have not seen a question that asks to loop each worksheet in each workbook in a directory. I have done some research and all that seems to come up for me is looping worksheets in a single workbook.
Any help would be appreciated.
Thank you
回答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
来源:https://stackoverflow.com/questions/43503522/looping-through-excel-worksheets-in-mulitple-workbooks-in-the-same-directory-wh