I am having trouble with the following macro. It works fine one or two
times, but if I use it three times, I get a dialog box that says "Program
Error" with nothing else but an o.k. button. If I select o.k. or leave it
alone for a few seconds, all Excel windows close. The error occurs at the
ActiveWorkbook.Close line four lines up from the bottom.

Can anybody help?

Sub CREATEPSR()
'
' CREATEPSR Macro
' Macro recorded 1/27/2005 by me
'

'
On Error Resume Next
Sheets("PSR").Copy
ChDir "C:\Documents and Settings\" & Application.UserName & "\Desktop"

Range("C69:C71").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\" &
Application.UserName & "\Desktop\" & Cells(1, 1) & Format(Date, "
yyyy-mm-dd"), FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

ActiveWorkbook.Save
ActiveWorkbook.Close
Sheets("Main").Select
Range("D6").Select
End Sub