retrieve cell value from the cosed file

This doesn't require you to open the workbooks. Since you have 400, I would
think the workbook open/copy/close approach will be rather klunky. I just
wrote this for you just now and havn't had occasion to use it so can't
confirm its reliability. Suggest you give it a shot.

Regards,
Greg

Sub GetValsByFormula()
Dim FNs As Variant
Dim FN As String, Pth As String
Dim i As Integer

On Error GoTo ExitProc
FNs = Application.GetOpenFilename _
("Excel Files(*.xl?), *.xl?", MultiSelect:=True)
If TypeName(FNs) = "Boolean" Then Exit Sub
FN = Dir(FNs(LBound(FNs)))
Pth = Left(FNs(LBound(FNs)), Len(FNs(LBound(FNs))) - Len(FN))
For i = LBound(FNs) To UBound(FNs)
FN = Dir(FNs(i))
Cells(i, 1).Formula = "= '" & Pth & "[" & FN & "]Sheet1'!A1"
Cells(i, 2).Formula = "= '" & Pth & "[" & FN & "]Sheet1'!B1"
Next
ExitProc:
End Sub

"igorek" wrote:

> Hello,
>
> I have 400 files in the direcrory of the identical format. in order to
> create a proper check tool i need my code to go into every single file pick
> up values in cells A1 and B1 and populate these values in the ActiveWorkbook
> in the following manner
> A1 B1
> File 1 x y
> File 2 y z
> File 3 w m
>
> Thank you
> Igor

The thought occurred to me that, after obtaining the values by formulae, you
should convert them to values so that they are no longer linked. Suggested is
this:

Sub GetValsByFormula()
Dim FNs As Variant
Dim FN As String, Pth As String
Dim i As Integer
Dim r As Range

On Error GoTo ExitProc
FNs = Application.GetOpenFilename _
("Excel Files(*.xls), *.xls", MultiSelect:=True)
If TypeName(FNs) = "Boolean" Then Exit Sub
FN = Dir(FNs(LBound(FNs)))
Pth = Left(FNs(LBound(FNs)), Len(FNs(LBound(FNs))) - Len(FN))
For i = 1 To UBound(FNs)
FN = Dir(FNs(i))
Cells(i, 1).Formula = "= '" & Pth & "[" & FN & "]Sheet1'!A1"
Cells(i, 2).Formula = "= '" & Pth & "[" & FN & "]Sheet1'!B1"
Next
Set r = Range(Cells(1, 1), Cells(UBound(FNs), 2))
r.Copy
r.PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
ExitProc:
End Sub

Regards,
Greg

One more tweak. In place of:

> r.Copy
> r.PasteSpecial (xlPasteValues)
> Application.CutCopyMode = False

try instead:

r.Value = r.Value

Sorry for all the changes. This is all experimental. Never actually done
this.

Regards,
Greg


"Greg Wilson" wrote:

> The thought occurred to me that, after obtaining the values by formulae, you
> should convert them to values so that they are no longer linked. Suggested is
> this:
>
> Sub GetValsByFormula()
> Dim FNs As Variant
> Dim FN As String, Pth As String
> Dim i As Integer
> Dim r As Range
>
> On Error GoTo ExitProc
> FNs = Application.GetOpenFilename _
> ("Excel Files(*.xls), *.xls", MultiSelect:=True)
> If TypeName(FNs) = "Boolean" Then Exit Sub
> FN = Dir(FNs(LBound(FNs)))
> Pth = Left(FNs(LBound(FNs)), Len(FNs(LBound(FNs))) - Len(FN))
> For i = 1 To UBound(FNs)
> FN = Dir(FNs(i))
> Cells(i, 1).Formula = "= '" & Pth & "[" & FN & "]Sheet1'!A1"
> Cells(i, 2).Formula = "= '" & Pth & "[" & FN & "]Sheet1'!B1"
> Next
> Set r = Range(Cells(1, 1), Cells(UBound(FNs), 2))
> r.Copy
> r.PasteSpecial (xlPasteValues)
> Application.CutCopyMode = False
> ExitProc:
> End Sub
>
> Regards,
> Greg
>

I have a example here also
http://www.rondebruin.nl/summary2.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Greg Wilson" <GregWilson@discussions.microsoft.com> wrote in message news:C0C118B6-AEAC-429C-A950-9A70050412BD@microsoft.com...
> This doesn't require you to open the workbooks. Since you have 400, I would
> think the workbook open/copy/close approach will be rather klunky. I just
> wrote this for you just now and havn't had occasion to use it so can't
> confirm its reliability. Suggest you give it a shot.
>
> Regards,
> Greg
>
> Sub GetValsByFormula()
> Dim FNs As Variant
> Dim FN As String, Pth As String
> Dim i As Integer
>
> On Error GoTo ExitProc
> FNs = Application.GetOpenFilename _
> ("Excel Files(*.xl?), *.xl?", MultiSelect:=True)
> If TypeName(FNs) = "Boolean" Then Exit Sub
> FN = Dir(FNs(LBound(FNs)))
> Pth = Left(FNs(LBound(FNs)), Len(FNs(LBound(FNs))) - Len(FN))
> For i = LBound(FNs) To UBound(FNs)
> FN = Dir(FNs(i))
> Cells(i, 1).Formula = "= '" & Pth & "[" & FN & "]Sheet1'!A1"
> Cells(i, 2).Formula = "= '" & Pth & "[" & FN & "]Sheet1'!B1"
> Next
> ExitProc:
> End Sub
>
> "igorek" wrote:
>
>> Hello,
>>
>> I have 400 files in the direcrory of the identical format. in order to
>> create a proper check tool i need my code to go into every single file pick
>> up values in cells A1 and B1 and populate these values in the ActiveWorkbook
>> in the following manner
>> A1 B1
>> File 1 x y
>> File 2 y z
>> File 3 w m
>>
>> Thank you
>> Igor