Try this routine;
Notes:
1) Not fully tested.
2) Assumes sheet name = Sheet1
3) Change Dirs as required.<pre/>
Option Base 1
Sub GetValueFromClosedFile_ViaFormula()
Dim sDir As String
Dim ShtCellLoc(3) As String
Dim DataRg As Range
Dim Files
Dim x As Double
'/////////////////////////////////////////////////////////////////
'// Info: /
'// Files :"P046000.xls" to "P057999.xls". /
'// /
'// Cells to extract information from: "C2, I57, I58". /
'// /
'// Info to be copied to A2, B2, C2 and so on for 12000 rows, /
'// keeping the 3 columns common. /
'/////////////////////////////////////////////////////////////////
'// This is the Dir to search in
sDir = "C:analysis"
'// This is the Location/cell address
ShtCellLoc(1) = "Sheet1'!$C$2"
ShtCellLoc(2) = "Sheet1'!$I$57"
ShtCellLoc(3) = "Sheet1'!$I$58"
Files = Dir(sDir & "*.xls")
'// Clear area Column A to place data in
Columns("A:C").Clear
'speed things up
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = 2
On Error GoTo FileError
Do While Len(Files) > 0
Cells(x, 1) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(1)
Cells(x, 2) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(2)
Cells(x, 3) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(3)
x = x + 1
Files = Dir()
Loop
'// calculate NOW!!
Application.Calculate
Set DataRg = Range(Range("A2:C2"), Range("A2:C2").End(xlDown))
DataRg.Copy
DataRg.PasteSpecial Paste:=xlValues
Columns("A:C").Columns.EntireColumn.AutoFit
Application.CutCopyMode = False
Set DataRg = Nothing
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True
MsgBox "Done!...updating complete", vbInformation + vbSystemModal, "Update Status" '64+4096
Exit Sub
FileError:
MsgBox Err.Number & Chr(13) & _
Err.Description & Chr(13) _
, vbCritical + vbMsgBoxHelpButton, _
"File Error", _
Err.HelpFile, _
Err.HelpContext
End Sub</pre>
_________________
Kind Regards,<font size=+2><font color="red"> I<font color="blue">van<font color="red"> F M</font color="blue">oala</font></font></font><A HREF= "http://www.gwds.co.nz/"><font color="green">
http://www.gwds.co.nz/excel_files.html - Under Constru
This message was edited by Ivan F Moala on 2002-04-27 17:02