Visual Basic Como criar rotina para autosalvamento de uma planilha como novo arquivo

[Eliéser Barbosa]

Na minha pasta de trabalho eu possuo uma rotina de salvamento ativada por botão. Segue abaixo o codigo.

Sub copyseg()

    Dim WP As Workbook                                                               'Pasta de trabalho atual
    Dim WS As New Workbook                                                           'Nova pasta de trabalho
    Dim WPSheet As Worksheet                                                         'Planilha atual
    Dim rngWP As Range                                                               'Regiao com dados da planilha atual
                
    Set WP = ActiveWorkbook                                                          'Variável WP = Pasta de trabalho atual
    Set WPSheet = WP.Sheets("PACIENTES")                                             'Variavel Worksheet atrelada a workbook atual)

        Sheets("PACIENTES").Visible = xlSheetVisible                                 'A planilha PACIENTES está inativa, este código torna ela ativa novamente.
      
        WPSheet.Select
        WPSheet.UsedRange.Copy                                                       'Copia todas as células utilizadas
    Set WS = Workbooks.Add                                                           'Adiciona uma nova workbook
        WS.Sheets(1).Select                                                          'Seleciona a planilha a ser copiada



        ActiveCell.PasteSpecial Paste:=xlValues                                      'Cola os dados copiados na planilha nova.

        WS.Sheets(1).Name = WPSheet.Name                                             'Mantem o mesmo nome da planilha original

        Application.DisplayAlerts = False                                            'Desabilita todos os alertas do excel, não mostrará as caixas de dialogo.

        WS.SaveAs WP.Path & "\CopySeg_PACIENTES - " & Year(Date) & "_" & Month(Date) 'Determina o nome do arquivo como CopySeg_PACIENTES-Ano_mês
        WS.Close savechanges:=True
            Application.DisplayAlerts = True                                         'Reabilita todos os alertas do excel
            WP.Activate
            WP.Sheets(1).Select                                                      'Seleciona a planilha PACIENTES no novo arquivo
            WPSheet.Range("A1").Select                                               'Seleciona a celula "A1" da Planilha PACIENTES no novo arquivo
                     Sheets(1).Visible = xlSheetVeryHidden                           'Retona a planilha PACIENTES (arquivo original) na condição de inativa outra vez
    
    MsgBox "Geração do arquivo concluída.", vbOKOnly                                 'Cria a caixa de dialogo informando o fim da execucao do código
End Sub

Gostaria de saber se tem como eu usar essa rotina com um codigo de autosave. Gostaria que este codigo fosse executado automaticamente a cada 30 min. 

Se não for possivel criar a rotina acima gostaria de uma rotina que salvasse a cada 30 min uma copia da minha planilha, que está invisivel, em um novo arquivo com nome e data pre-estipulado por mimjá no codigo, em local a ser escolhido. Estou usando a rotina acima porque ela satisfaz quase todos os requisito para uso, só nao consigo escolher o local em que o bckup sera salvo.

 

Ex: Arquivo original = C:\Macros\Cad_Paciente.xlsm

      Cópia do arquivo = C:\Documentos\CadastroBackup

 

Alguem tem alguma sugestao?

[Basole]

Tente algo assim:

 

Em EstaPastadeTrabalho

 

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:30:00"), "MeuBackUp"
End Sub

E em um modulo padrão:

Public vTime As Date
Sub MeuBackUp()
  vTime = vba.Now + vba.TimeValue("00:30:00")
  Application.OnTime vTime, "MeuBackUp"
  ActiveWorkbook.SaveAs Filename:="C:\Documentos\CadastroBackup\" & ThisWorkbook.Name, FileFormat:=xlNormal, _
  Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
  CreateBackup:=False 
End Sub

: 

 

 

[Eliéser Barbosa]

 rotina serviu, mas precisava era salva a sheet PACIENTES a cada 30 Min sem perguntar se quer subistuir, salvando sobreescrevendo mesmo.

 

Teria como adptar a rotina acima para salvar todo o arquivo todo no dia 1 de cada mes?

 

Desde ja agradesco Basole.