Hi again Vijay,

My apologies if you get this twice but my first reply seems to have gone
into cyberspace.

Warning: The code deletes files.
Ensure that you have backups in another location before attempting to run
the code. Also note all of the comments in the code.

You should be able to test the code using the MsgBox but I suggest that you
comment out the Kill line (delete file) before you do so. You will then only
have to delete the newly created files in the new location.

Basically what the code does is read the files, test for numeric the last 3
characters before the dot, copy the names to a single dimension array.

Then copies the file names to a 2 dimension array with the numeric serial in
the second dimension (or column).

Sorts the 2 dimensional array on the serial number.

Uses the array to open the files sequentially.



Sub Test()

Dim strPathInit As String
Dim strPathSave As String
Dim strFile As String
Dim arrFiles()
Dim arrCopy()
Dim i As Long
Dim j As Long
Dim temp1
Dim temp2
Dim lastChrPos As Integer
Dim wbSer As Workbook

strPathInit = ThisWorkbook.Path & "\"
'Alternate method of assigning path to variable
'Don't forget the backslash on end.
'strPathInit = "C:\User\Documents\Excel\Test\"

strPathSave = strPathInit & "SavedFiles\"
'Alternate method
'strPathSave = _
"C:\User\Documents\Excel\Test\SavedFiles\"

'If using xl2007 then modify file extension
'to xlsx
strFile = Dir(strPathInit & "*.xls", vbNormal)

Do While strFile < ""
lastChrPos = InStrRev(strFile, ".") - 3
'Only files with 3 numerics preceding the dot _
included and this workbook is excluded.
If IsNumeric(Mid(strFile, lastChrPos, 3)) _
And strFile < ThisWorkbook.Name Then

i = i + 1
'Save file name in single dimensional array
ReDim Preserve arrFiles(1 To i)
arrFiles(i) = strFile

End If
strFile = Dir()
Loop

If i = 0 Then
MsgBox "No files matching path and criteria found" _
& vbCrLf & "Processing terminated"
Exit Sub
End If

'Copy files to 2 dimensional array
'and copy serial to second dimension.
ReDim arrCopy(1 To UBound(arrFiles), 1 To 2)
For i = LBound(arrFiles) To UBound(arrFiles)
arrCopy(i, 1) = arrFiles(i)
lastChrPos = InStrRev(arrFiles(i), ".") - 3
arrCopy(i, 2) = Mid(arrFiles(i), lastChrPos, 3)
Next i

'Sort array on serial number.
For i = LBound(arrCopy) To UBound(arrCopy)
For j = LBound(arrCopy) To UBound(arrCopy) - 1
If arrCopy(j, 2) arrCopy(j + 1, 2) Then
temp1 = arrCopy(j, 1)
temp2 = arrCopy(j, 2)
arrCopy(j, 1) = arrCopy(j + 1, 1)
arrCopy(j, 2) = arrCopy(j + 1, 2)
arrCopy(j + 1, 1) = temp1
arrCopy(j + 1, 2) = temp2
End If
Next j
Next i

For i = LBound(arrCopy) To UBound(arrCopy)
Workbooks.Open Filename:= _
strPathInit & arrCopy(i, 1)

'Assign workbook to a variable
'for use in your code
Set wbSer = Workbooks(arrCopy(i, 1))

'########################################
'Place your code in here in lieu of msgbox

MsgBox "File name: " & wbSer.Name & " opened"

'########################################

'Save the file to new location
wbSer.SaveAs Filename:= _
strPathSave & wbSer.Name

'Close the file
wbSer.Close

'Delete the old file. (NOT RECOMMENDED)
'Better to delete manually after you
'are confident that code has run properly.
'Files deleted by code are not recoverable
'from the Recycle bin.
Kill (strPathInit & arrCopy(i, 1))

Next i

Exit Sub

End Sub

--
Regards,

OssieMac