I can give you a hand with this. I'm working on a piece of code which can maybe achieve something like this. I'll see if I can figure out what the requirements would be and post some more ideas later.
In the meantime, some ideas first of all ;
You'll need to know the filenames of the workbooks. These should get stored in an array.
You'll need a loop which will go through the workbooks,
A Loop which will go through each sheet in the workbook,
A Variable which will contain the address of the "Total Apples" cell when it's found,
Using the address variable, locate the desired cell which contains the value you want, using .Offset. This value should be added to an array also.
Finish the loops, and your end result should be an array of information which tells you the value, the workbook it was found on, and in which sheet it was found.
Infact, here you go - just wrote this for you. Rip it apart and have a look at it, try to figure out how it works. Does a complex action, but it's quite simple to see how it works once you look at it and follow it through.
Dim SEARCHSTRING As String
SEARCHSTRING = "Total Apples"
Dim mWorkbooks() As String, mNumberOfWorkbooks As Long, mWorkbookCounter As Long
Dim mValuesFound() As Double, mValueFoundCounter As Long, mCounter As Long
Dim mWorkbookFoundIn() As String
Dim mWorksheetFoundIn() As String
Dim ValueOFFSET_Row As Long
Dim ValueOFFSET_Col As Long
Dim mSheetCount As Long, mSheetCounter As Long
Dim mFoundAddress As String
mNumberOfWorkbooks = 3
ReDim mWorkbooks(1 To mNumberOfWorkbooks)
mWorkbooks(1) = "C:\Temp\wb1.xls"
mWorkbooks(2) = "C:\Temp\wb2.xls"
mWorkbooks(3) = "C:\Temp\wb3.xls"
ValueOFFSET_Row = 0
ValueOFFSET_Col = 1
mWorkbookCounter = 1
For mWorkbookCounter = 1 To 3
mSheetCount = ActiveWorkbook.Sheets.Count
For mSheetCounter = 1 To mSheetCount
mFoundAddress = ""
On Error Resume Next
mFoundAddress = Cells.Find(What:=SEARCHSTRING, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
On Error GoTo 0
If mFoundAddress <> "" Then
mValueFoundCounter = mValueFoundCounter + 1
ReDim Preserve mValuesFound(1 To mValueFoundCounter)
mValuesFound(mValueFoundCounter) = ActiveSheet.Range(mFoundAddress).Offset(ValueOFFSET_Row, ValueOFFSET_Col).Value
ReDim Preserve mWorkbookFoundIn(1 To mValueFoundCounter)
mWorkbookFoundIn(mValueFoundCounter) = mWorkbooks(mWorkbookCounter)
ReDim Preserve mWorksheetFoundIn(1 To mValueFoundCounter)
mWorksheetFoundIn(mValueFoundCounter) = ActiveSheet.Name
Dim mMSG As String
mMSG = "Values :" & vbCr & vbCr
If mValueFoundCounter = 0 Then mMSG = mMSG & "NO VALUES FOUND"
For mCounter = 1 To mValueFoundCounter
mMSG = mMSG & mWorkbookFoundIn(mCounter) & vbTab
mMSG = mMSG & mWorksheetFoundIn(mCounter) & vbTab
mMSG = mMSG & mValuesFound(mCounter)
mMSG = mMSG & vbCr