Macro paraguardar una copia en carpetaque crea e imprimir cuando cierro la hoja

Private Sub BuscayCreaCarpeta()
Dim mes1 As String
Dim mes, año As Integer

'Establezco si la carpeta existe

año = Year(Date)
mes = Month(Date)

'Determino el nombre de la subcarpeta que va dentro de la carpeta año, hay que tener en cuenta que los informes se
'sacan al mes siguiente, en caso de ser diciembre deber{ia tenerse en cuenta que se saca en enero del año que sigue
'por ende el directorio donde se guardan los datos es el del año anterior que ya está en teoría creado.

'Se pone como nombre de mes el anterior al mes actual, ya que los informes se sacan el mes siguiente
Select Case mes
Case 1
mes1 = "Ene"
Case 2
mes1 = "Feb"
Case 3
mes1 = "Mar"
Case 4
mes1 = "Abr"
Case 5
mes1 = "May"
Case 6
mes1 = "Jun"
Case 7
mes1 = "Jul"
Case 8
mes1 = "Ago"
Case 9
mes1 = "Sep"
Case 10
mes1 = "Oct"
Case 11
mes1 = "Nov"
Case 12
mes1 = "Dic"
End Select

'Se establece que si el mes es diciembre el año donde se guarden los archivos es el actual menos 1 osea el anterior
If mes1 = "Dic" Then
año = año - 1
End If

'Verifica que la carpeta con el nombre del año se encuentre caso contrario la crea
Path = "C:\Users\SERVIDOR\Desktop\CIERRE CJA" & año
If Dir(Path, vbDirectory) = "" Then
MkDir Path
End If

'Verifica que la carpeta con el nombre del mes se encuentre caso contrario la crea

path1 = "C:\Users\SERVIDOR\Desktop\CIERRE CJA" & año & "\" & mes1
If Dir(path1, vbDirectory) = "" Then
MkDir path1
End If
End Sub
Sub GuardarCopia()
Dim NombreArchivo As String
NombreArchivo = Format(Date, "dd - mm - yyyy")
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\SERVIDOR\Desktop\CIERRE CJA" & año & "\" & mes1 & NombreArchivo & ".xls"
End If
End Sub

Option Explicit
Private Sub Workbook_NewChart(ByVal Ch As Chart)

End Sub

Private Sub Workbook_Open()
Dim Mensaje, Resp

Resp = MsgBox("¿Desea autoincrementar?", vbYesNo)

If Resp = vbYes Then
Range("E3").Value = Range("E3").Value + 1
End If

ThisWorkbook.save

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Mensaje As String
Dim Resp As Boolean
Mensaje = "Muchas Gracias por usar Remesas"
Resp = False
Resp = IIf(MsgBox("Desea Guardar una Copia?", _
vbQuestion + vbYesNo, "Atención") = vbYes, True, False)
MsgBox Mensaje, vbInformation, "Hasta Pronto"
If Resp Then
Application.Dialogs(xlDialogSaveAs).Show
End If
End Sub

Sub MostrarRutaArchivo()
'Mostramos la ruta del archivo actual.
MsgBox ThisWorkbook.Path
'
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim copias As Integer
Dim hoja As String
copias = InputBox("¿Cuantas copias quiere imprimir?")
hoja = InputBox("Escriba que hoja quiere imprimir")
ActiveSheet.PageSetup.PrintArea = Selection.Address
ActiveWindow.SelectedSheets.PrintOut Copies:=copias, Collate:=True
End Sub

Esto lo saque de otras paginas lo que quiero si pudieran ayudarme seria que me crear una carpeta con la fecha actualizada me guarde una copia de la hoja sin cerrarla y mande a imprimir y me limpie la hoja de las gracias con una caja de usar la hoja remesa