在同一目录中的多个工作簿中循环浏览excel工作表，同时将数据复制到新工作簿中 [英] Looping through excel worksheets, in mulitple workbooks in the same directory while copying data into a new workbook

问题描述

因此，我已经工作了几个小时，以研究如何使现有代码以我希望的方式运行.此代码本身将循环遍历目录中的工作簿，并将数据从第一张工作表上的特定单元格复制到新工作簿.我想这样做，但是还要遍历每个工作簿中的每个工作表以获取所需的数据.我会发布我尝试过的所有数据版本，但是我敢肯定，这也会使我被禁.因此，我将发布我的最新消息:

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()

Sub GatherData()

将wkbkorigin用作工作簿昏暗的原始表作为工作表昏暗的数据表作为工作表昏暗的结果行一样长昏暗的Fname作为字符串昏暗RngDest作为范围昏暗的工作表

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

结束子

因此，当前版本为我提供了错误运行时错误1004，应用程序定义或对象定义的错误.

So This current version gives me the error "Runtime Error 1004, Application defined or Object defined error.

我尝试过的以前版本的代码完成了以下工作:-完全不复制任何数据(使用"For each ws"语句)-错误没​​有执行操作的循环"(使用带计数器的for语句)-一般编译错误.

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.

任何帮助将不胜感激.

谢谢

推荐答案

您需要的结构是:

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中迭代/循环的几种方法:

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

这篇关于在同一目录中的多个工作簿中循环浏览excel工作表，同时将数据复制到新工作簿中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！