Looping through excel worksheets, in mulitple workbooks in the same directory while copying data into a new workbook

倾然丶 夕夏残阳落幕 提交于 2021-02-05 08:57:18

问题


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

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!