Pull data from specific cell in Multiple Workbooks

[lumpy]

I have a folder containing .xls workbooks
The workbooks are all in monthly subfolders.
These workbooks are invoices.
The workbooks each have an invoice total in sheet 1 cell H2.
The files are all named with the customers lastnamefirstinitial.xls.

I would like to be able to click a button in a workbook and have it go and open each workbook in the folder and all subfolders. I would like pull the data from each workbook sheet 1 cell H2 into the current workbook. I would like to sum all of the totals from each worksheet into a cell in the current worksheet.
It would be nice to have each invoice total listed in the same column with the total of all invoices in that column in the next column.

Any pointers would be greatly appreciated.

 

[BrianB]

You will need to adapt this a bit :-

Sub PROCESS_FILES()
    Dim MyFolder As String
    Dim MyFile As String
    Dim MyValue As Double
    '--------------------
    MyValue = 0
    MyFolder = "C:\temp\"
    MyFile = Dir(MyFolder & "*.XLS")
    Do While MyFile <> ""
        Application.StatusBar = MyFile
        Workbooks.Open FileName:=MyFolder & MyFile
        MyValue = MyValue + ActiveWorkbook.Sheets(1).Range("H2").Value
        ActiveWorkbook.Close savechanges:=False
        MyFile = Dir
    Loop
    ThisWorkbook.Sheets(1).Range("H2").Value = MyValue
    MsgBox (MyValue)
    Application.StatusBar = False
End Sub

 

[lumpy]

Thank You for the promt help.

But being the newbie I am, I still need some more help.

How do I modify this code to run on the folder and all subfolders

 

[gio123bg]

Hi,
I have tested the following condition.


C:\tmp\dir1\file1.xls
C:\tmp\dir2\file2.xls

I copy a value from last sheet in file1 and file1 (both sheet12) on my book1.sheet1 where I have defined my macro and found in C:\xx\yy\zz\kkk

Sub findremotevalues()
Dim MyFolder As String
Dim RootClaim As String
Dim MyFile As String
Dim MyValue As Double
Dim myArray(50) As String
'--------------------
RootDir = "C:\tmp\"
MyFolder = Dir(RootDir, vbDirectory)
MyFolder = Dir
MyFolder = Dir

dirtemp = RootDir & Dir(RootDir, vbDirectory)
MyFolder = Dir
' after the folder "." and ".."
i = 1
MyFolder = Dir
Dim ii As Integer
Erase myArray
ii = 0
Do While MyFolder <> ""
ii = ii + 1
myArray(ii) = MyFolder
MyFolder = Dir
Loop

j = 1
dirtemp = RootDir & myArray(j) & "\"
MyFile = Dir(dirtemp & "*.xls")
Do While MyFile <> ""
Application.StatusBar = MyFile
Workbooks.Open Filename:=dirtemp & MyFile
MyValue = ActiveWorkbook.Sheets(14).Range("C20").Value
ThisWorkbook.Sheets(1).Range("C20").Value = MyValue
Sheet1.Cells(i, 1) = MyValue
'MyValue = MyValue + ActiveWorkbook.Sheets(1).Range("H2").Value
ActiveWorkbook.Close savechanges:=False
j = j + 1
dirtemp = RootDir & myArray(j) & "\"
Loop
End Sub


Giovanni

 

[MartinK]

Hi Lumpy,
just regarding file search in subdirectories:
I like filesearch

Sub FindMe()
With Application.FileSearch
    .NewSearch
    .LookIn = "C:\YourPathHere\"
    .SearchSubFolders = True
    .Filename = "*.xls" 'or any other wildcard

    If .Execute() > 0 Then
        MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
End Sub

Combine this with Brian's code and you'll get what you want.
Regards
Martin