codigo con sendkeys

Hola a todos!
Escribi esto, funciona bien hasta que quiero grabar por segunda vez, ya lo
revise y no me doy cuenta como debo seguir, agradecido si alguien me puede
ayudar.

Sub CrearResguardo()
Ruta = ThisWorkbook.Path
If Dir("" & Ruta & "\Resguardo.xls") = "" Then
Set NewBook = Workbooks.Add: NewBook.SaveAs Filename:="" & Ruta &
"\Resguardo.xls"
Workbooks("Resguardo.xls").Close savechanges:=True
Workbooks.Open Filename:="" & Ruta & "\Resguardo.xls"
Application.SendKeys "%{f11}^{r}{end}~", True
Application.SendKeys "Private Sub Workbook_Open~", True
Application.SendKeys "Application.EnableEvents=False{tab}{down 2}", True
Application.SendKeys "Private Sub Workbook_BeforeClose{(}Cancel As
Boolean{)}~", True
Application.SendKeys "Application.EnableEvents=True{tab}{down 2}", True
Application.SendKeys "%{f4}" 'Hasta aqui funciona.
'Workbooks("Resguardo.xls").Close savechanges:=True
End If
End Sub