使用VBA和Excel从文件夹中的文件收集数据

Question

我对VBA和macro还是很陌生，所以我在这里写一篇文章，希望能对我的解决方案获得一些帮助和提示。 我的问题如下：

我需要从文件夹和子文件夹的excel文件中复制包含单元格数据的不确定数量的单元格，以粘贴到excel-“母亲”文件中：

“所有包含数据的文件都在一个文件夹中，并且是其子文件夹。要复制到这些文件中的单元格始终从第40行开始，并且分别位于A，B，C和D单元格中。但是，需要复制多少行不确定。”

我正在寻找的是循环遍历文件夹的代码，而子文件夹则在寻找文件以获取数据。 我还认为，在此循环中，我稍后将编写代码以从每个单独的文件收集数据。

因此，我正在寻找的是：-代码遍历文件夹和子文件夹以从文件中收集数据。 -查找包含数据的最后一行并将所有数据从开始复制到最后一行的代码。 我在想：“ A40：D＆UncertainRange”

非常感谢所有帮助。.毕竟我仍然是VBA Noob。 周末愉快，也许您的所有问题都可以通过脚本解决。

美好的一天。

Answer 1

看一下此链接： http : sRootPath用目录结尾更改sRootPath ，不带\\

Answer 2

这是用于识别具有数据的Excel工作表中的最后一行的命令：

lastRow = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

要遍历每个文件第40行开始的数据，可以使用如下所示的内容：

lastRow = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For iRow = 40 to lastRow
    destinationSheet.Cells(outputRow, 1) = sourceSheet.Cells(iRow, 1)
    destinationSheet.Cells(outputRow, 2) = sourceSheet.Cells(iRow, 2)
    destinationSheet.Cells(outputRow, 3) = sourceSheet.Cells(iRow, 3)
    destinationSheet.Cells(outputRow, 4) = sourceSheet.Cells(iRow, 4)
    outputRow = outputRow + 1
Next iRow

要遍历文件，请使用以下命令：

Sub mySub()
Dim strFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "C:\"
    .title = "Please select a folder..."
    .Show
    If .SelectedItems.Count > 0 Then
        strFolder = .SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
End With
Dim myobject As Object
Set myobject = CreateObject("Scripting.FileSystemObject")
Set mysource = myobject.GetFolder(strFolder)
Application.Workbooks.Open ("c:\motherWorkbook.xlsx")
For Each MyFile In mysource.Files

    ''' Do Something with files in main folder

Next

' Subfolders
For Each mySubFolder In mysource.Subfolders
    Set mysource = myobject.GetFolder(mySubFolder.Path)
    For Each MyFile In mysource.Files

        ''' Do Something with files in sub folders

    Next
Next
End Sub