I don't see how the commented out code would ever be unstable - particulary
no instability based on running it more than once (unless you consumed all
the rows).

the uncommented code is dependent on sh being the activesheet. Given that
dependency it is possible that it would sometimes fail. If MicawberXLdb.xls
is already open, there is nothing in your code that would insure it is the
activeworkbook and Full CAB Database the activesheet.


--
Regards,
Tom Ogilvy


"Michael Beckinsale" wrote in message
...
Hi All,

Pasted below is the VBA code l have writen to copy and paste a range to
another workbook (MicawberXLdb.xls) in which one sheet of several will
form
a database from which a csv file will be created depending on criteria
selected.
Approx 40 workbooks will feed the database sheet.

You will see that the Sub uses a Function called LastRow. The code in the
function which has been "commented out" worked however if data was deleted
from the database it always found the last row that did have data in it
before the deletion ! I then replaced the code with what you can see and
although it works it sometimes returns an error message if its run several
times. The original code also had the same problem.

Can anybody tell me why this code is unstable ?

All contributions gratefully received.

Sub exporttoMED()
'Exports the FULL CAB PROFILED outputs to the MicawberXLdb.xls file.
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim WBP As String 'Added by MB

WBP = ThisWorkbook.Path
Application.ScreenUpdating = False
If bIsBookOpen("MicawberXLdb.xls") Then
Set destWB = Workbooks("MicawberXLdb.xls")
Else
Set destWB = Workbooks.Open(WBP & "\MicawberXLdb.xls")
End If
Lr = LastRow(destWB.Worksheets("Full CAB Database")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Full CAB
Profiled").Range("A5:S44")
Set destrange = destWB.Worksheets("Full CAB Database").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
ThisWorkbook.Activate
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
sh.Range("A1").Activate
LastRow = ActiveCell.End(xlDown).Row

'Original code
' 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