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

Hi Igorek,

See Ron De Bruin's 'Copy cells or sheet from all or some workbooks in a
folder' page at:

http://www.rondebruin.nl/copy3.htm


---
Regards,
Norman



"igorek" wrote in message
...
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

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" wrote in message ...
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