It is usually done like this. Subsequent calls to Dir have no argument. by
putting in an argument, you are starting back over at the first file.

Sub ExtractDataFromFiles()
Const sPath = "C:\Documents and Settings\Test\"
Dim sName As String
Dim wb As Workbook
Dim j As Integer
Dim n As Integer
Dim r(1 To 14) As Variant
' Load UserForm1
' UserForm1.Show False 'Your Macro is Running
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
sName = Dir(sPath & "*.xls")
j = 6 ' Data starts on Row 6
Do While sName < ""
Set wb = Workbooks.Open(sPath & sName)
With wb.Worksheets("Cost Analysis")
r(1) = .Range("J2").Value
r(2) = .Range("B4").Value
r(3) = .Range("B6").Value
r(4) = .Range("G4").Value
r(5) = .Range("G6").Value
r(6) = .Range("G6").Value
r(7) = .Range("J1").Value
r(8) = .Range("G51").Value
r(9) = .Range("G53").Value
r(10) = .Range("G54").Value
r(11) = .Range("G56").Value
r(12) = .Range("G57").Value
r(13) = .Range("G58").Value
r(14) = .Range("G59").Value
End With
wb.Close SaveChanges:=False
With ThisWorkbook.ActiveSheet
For n = 1 To 14
.Cells(j, n).Value = r(n)
Next n
End With
j = j + 1
'End If
'Set wb = Nothing
'
' added line
'
sName = Dir
Loop
End Sub

--
Regards,
Tom Ogilvy

"Jim May" wrote:

I see my error, but don't know how to fix it.
Can someone assist?
TIA

Sub ExtractDataFromFiles()
Const sPath = "C:\Documents and Settings\Test\"
Dim sName As String
Dim wb As Workbook
Dim j As Integer
Dim n As Integer
Dim r(1 To 14) As Variant
' Load UserForm1
' UserForm1.Show False 'Your Macro is Running
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
sName = Dir(sPath & "*.xls")
j = 6 ' Data starts on Row 6
Do While sName < ""
sName = Dir(sPath & "*.xls") <<<<<<<< File Name Not Changing
because of Line 12
Set wb = Workbooks.Open(sPath & sName)
With wb.Worksheets("Cost Analysis")
r(1) = .Range("J2").Value
r(2) = .Range("B4").Value
r(3) = .Range("B6").Value
r(4) = .Range("G4").Value
r(5) = .Range("G6").Value
r(6) = .Range("G6").Value
r(7) = .Range("J1").Value
r(8) = .Range("G51").Value
r(9) = .Range("G53").Value
r(10) = .Range("G54").Value
r(11) = .Range("G56").Value
r(12) = .Range("G57").Value
r(13) = .Range("G58").Value
r(14) = .Range("G59").Value
End With
wb.Close SaveChanges:=False
With ThisWorkbook.ActiveSheet
For n = 1 To 14
.Cells(j, n).Value = r(n)
Next n
End With
j = j + 1
'End If
'Set wb = Nothing
Loop
End Sub