Collecting data from files in folders with VBA and

Question

I'm fairly new to VBA and macro's, so I'm writing a post here to hopefully get some help and tips for my solution. My problem is as follows:

I need to copy an uncertain amount of cells containing data from excel-files in folders and subfolders to paste in an excel-"mother"-file:

"All files that contain data is in one folder and it's subfolders. the cells to be copied in theese files ALWAYS start at row 40, and are in cells A, B, C and D. How many rows that need to be copied however is uncertain."

What I'm looking for is code that loops through a folder and it's subfolders looking for files to get data from. I'm also thinking that inside this loop I will later write code to collect data from each individual file.

SO, what I'm looking for is: - Code to loop through a folder and subfolders to collect data from file. - Code that finds last row with data and copies all data from start to this last row. I'm thinking something like: "A40:D & UncertainRange"

All help is greatly appreciated.. afterall I'm still a VBA Noob. Have a great weekend, and may all of your problems be solved by scripting.

Good day.

Answer 1

Here's a command to identify the last row in an Excel sheet that has data:

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

To loop through your data beginning on row 40 of each file you can then use something like this:

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

To loop through files, use something like this:

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

Answer 2

have a look at this link: http://online-vba.de/vba_readfolder.php - change sRootPath with your directory without \ at the end