Question

所以我已经花了几个小时研究如何使现有代码按照我想要的方式运行。此代码本身将遍历目录中的工作簿，并将第一个工作表上的特定单元格中的数据复制到新工作簿。我想让它做到这一点，但也要浏览每个工作簿中的每个工作表以获取所需的数据。我会发布我尝试的所有数据版本但是，我确信这也会让我被禁止。所以我会发布最新的：

Sub GatherData（）

Dim wkbkorigin As Workbook 昏暗的起源表作为工作表 Dim destsheet As Worksheet Dim ResultRow As Long Dim Fname As String Dim RngDest作为范围 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，应用程序定义或对象定义错误。

我尝试过的代码的早期版本已完成以下操作： -did根本不复制任何数据（使用“For each ws”语句） -Error“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

在将数据复制到新工作簿时，在同一目录中的多个工作簿中循环使用excel工作表

1 个答案: