my error handler works only once??

[Piyush]

below is a sample of code to merge workbooks together. I am trying to merge all the workbooks with the "sheet1" in it. If it isnt in it..i want it to jump to the next file and ignore that error. heres the code. when debugging, it worked once...then a subscript out of range came because one of the files had no "Sheet1" in it. Please tell me what to do to fix this. I have over 500 files and they are increasing day by day. I can go thru every file and if there is no "Sheet1" i can put it in..but thats tedious.

Whats the matter with the error? why does it ONLY fix the error the first time and does go to errorfix: ??

Public Sub testsheet1() 'portions of file with excel sheets

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim lrow As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "H:\600 series PB free\PTI part completed!!"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Sheets("Sheet1").Select
basebook.Worksheets("Sheet1").Cells.Clear
'clear all cells on the first sheet
rnum = 1

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)

On Error GoTo errorfix

lrow = LastRow(mybook.Worksheets("Sheet1"))

Set sourceRange = mybook.Worksheets("Sheet1").Range("A2:IV" & lrow)

errorfix:
mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()


Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
after:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

[anilsolipuram]

Public Sub testsheet1() 'portions of file with excel sheets

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim lrow As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "H:\600 series PB free\PTI part completed!!"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Sheets("Sheet1").Select
basebook.Worksheets("Sheet1").Cells.Clear
'clear all cells on the first sheet
rnum = 1

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)

On Error resume next
lrow = LastRow(mybook.Worksheets("Sheet1"))
if err.description<>"" then
err.clear
go to errorfix:
else
end if
Set sourceRange = mybook.Worksheets("Sheet1").Range("A2:IV" & lrow)

errorfix:
mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()


Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
after:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function