Macro causes " Automation error" after some iterations

[murphree]

Hi,
I am trying to do what I thought was a simple task. Creating a spreadsheet to inventory cups each day.

When a macro was invoked do the following:
-unprotect the worksheet
-cut/paste the completed sheet below the current
-bring in the values form the previous day's inventory
-set protection on new spreadsheet to lock the cells
-blank out old values
-reprotect the worksheet

Pretty straightforward and seems to work fine for a few iterations, then crashes with "Run-time error '-2147417848 (80010108)': Automation error. The object invoked has disconnected from its clients.".

As FYI, this code was mostly generated using a record macro session, so no variables involved.

Here is a screenshot of the spreadsheet as it sits now:
spreadsheet.png

Here is the code:
Sub NewDay()
'
' NewDay Macro
' Create new day and copy cup count from previous day
'
' Keyboard Shortcut: Ctrl+n
'
'Unprotect sheet
ActiveSheet.Unprotect

' Create new day and copy cup count from previous day
Range("A2:J23").Select
Selection.Copy
Range("A24").Select
Selection.Insert Shift:=xlDown
Range("G28:H28").Select
Application.CutCopyMode = False
Selection.Copy
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G31:H31").Select
Application.CutCopyMode = False
Selection.Copy
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G34:H34").Select
Application.CutCopyMode = False
Selection.Copy
Range("C12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G37:H37").Select
Application.CutCopyMode = False
Selection.Copy
Range("C15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G40:H40").Select
Application.CutCopyMode = False
Selection.Copy
Range("C18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Protect cell cups counts form previous day
Range( _
"A26,A29,A32,A35,A38,A41,C28,D28,C31,D31,C34,D34,C37,D37,C40,D40,G28,H28,G31,H31,G34,H34,G37,H37,G40,H40,J42" _
).Select
Range("H40").Activate
Selection.Locked = True
Selection.FormulaHidden = False

' Clear out ending inventory from new day
Range("G6:H6").Select
Selection.ClearContents
Range("G9:H9").Select

Selection.ClearContents
Range("G12:H12").Select
Selection.ClearContents
Range("G15:H15").Select
Selection.ClearContents
Range("G18:H18").Select
Selection.ClearContents

'Clear cash drawer
Range("J20").Select
Selection.ClearContents

'Reprotect sheet
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

I am at a loss here. I have poured over any and all posts I can find, but none of the suggestions work so far. Any help would be appreciated!
I found a couple more suggestions at other sites and still no luck. Any ideas out there?

dale

[murphree]

Sorry, left out a detail.
Seems to crash more often when you put values in the ending inventory before running the macro

Dale

[murphree]

If anyone has any ideas on what can be causing this issue please chime in. Microsoft seems to be not much help either.
It seems to be unrelated to any other 'fixes' I have found though it has the same error.
If I need to just scrap it and do it some other way, so be it...but this has the look and feel for what my guys need to use already (of course it is not working )