Visual Basic Renomear aba com data especifica inserida no inicio da macro

[DricaBernardes]

Boa tarde

tenho uma macro, onde tenho uma planilha Modelo, e quando clico em "criar nova" a macro solicita qual data eu quero criar. Por exemplo, hoje estou criando a planilha do dia 18.10.2019, como eu faço para a macro ja renomear essa planilha de MODELO APROV 2 para 181019_APROV? alguem pode me ajudar?

obrigada 

[Basole]

@DricaBernardes post seu código para que o pessoal ajude a adaptar.

[DricaBernardes]

@basole, consegui fazer essa parte de criar e renomear a planilha, agora eu queria fazer uma substituição, porém se faço a gravacao da macro ela sempre vai utilizar da planilha que eu usei pra gravar e nao da ultima criada. Pode me ajudar a arrumar isso? Por exemplo, sao planilhas de pagamentos diarios, e a de tesouraria tem vinculo com a de aprovacao, entao quando eu gravei a macro pra substituir esse vinculo, ele sempre vai usar o 1810_APROVACAO... como eu faço pra ele alterar o vinculo para 19.10_APROVACAO, 2010_APROVACAO e assim por diante.

 

Sub CRIAR_NOVA()

'Sub CRIA_NOVA()
'
'CRIA NOVA PLANILHA DE DIA AO FINAL
'

'
    On Error GoTo MSGERRO:
    CRIARNOVA = InputBox("DIGITE A DATA DA PLANILHA A SER CRIADA (DDMM_APROVACAO)")
    
       
    
    Sheets("MODELO APROV").Visible = True
    Sheets("MODELO APROV").Select
    Sheets("MODELO APROV").Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
    
    Sheets("MODELO APROV (2)").Name = CRIARNOVA
    Sheets("MODELO APROV").Visible = False
    Sheets("HOME").Select
    MsgBox ("PLANILHA " & CRIARNOVA & " CRIADA COM SUCESSO")

Exit Sub

MSGERRO:
MsgBox ("DATA SOLICITADA JÁ EXISTE, POR FAVOR REINICIE O PROCESSO")
    Sheets("MODELO APROV (2)").Delete
    Sheets("MODELO APROV").Visible = False
    Sheets("HOME").Select

End Sub

Sub TESOURARIA()
'

'Sub TESOURARIA ()
'
'CRIA NOVA PLANILHA DE DIA AO FINAL
'

'
    On Error GoTo MSGERRO:
    CRIARNOVA = InputBox("DIGITE A DATA DA PLANILHA A SER CRIADA (DDMM_TESOURARIA)")
    
        
    Sheets("MODELO TES").Visible = True
    Sheets("MODELO TES").Select
    Sheets("MODELO TES").Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
    
    Sheets("MODELO TES (2)").Name = CRIARNOVA
        
    Sheets("MODELO TES").Visible = False
    
    Range("E3:E13").Select
    Selection.ClearContents
    Range("E3").Select
    ActiveCell.FormulaR1C1 = _
        "=1810_APROVACAO'!R[2]C[-2]+1810_APROVACAO'!R[3]C[-2]"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "=1810_APROVACAO'!R[3]C[-2]"
    Range("E5").Select
    ActiveCell.FormulaR1C1 = _
        "=1810_APROVACAO'!R[7]C[-2]+1810_APROVACAO'!R[8]C[-2]"
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "=1810_APROVACAO'!R[8]C[-2]"
    Range("E7").Select
    ActiveCell.FormulaR1C1 = _
        "=1810_APROVACAO'!R[12]C[-2]+1810_APROVACAO'!R[13]C[-2]"
    Range("E8").Select
    ActiveCell.FormulaR1C1 = "=1810_APROVACAO'!R[13]C[-2]"
    Range("E9").Select
    ActiveCell.FormulaR1C1 = _
        "=1810_APROVACAO'!R[17]C[-2]+1810_APROVACAO'!R[18]C[-2]"
    Range("E10").Select
    ActiveCell.FormulaR1C1 = "=1810_APROVACAO'!R[18]C[-2]"
    Range("E11").Select
    ActiveCell.FormulaR1C1 = _
        "=1810_APROVACAO'!R[22]C[-2]+1810_APROVACAO'!R[23]C[-2]"
    Range("E12").Select
    ActiveCell.FormulaR1C1 = "=1810_APROVACAO'!R[23]C[-2]"
    Range("E13").Select
    ActiveCell.FormulaR1C1 = "=1810_APROVACAO'!R[30]C[-2]"
    Range("E14").Select
    ActiveWindow.LargeScroll Down:=1
    Range("E40").Select
    ActiveWindow.LargeScroll Down:=-1
    Range("E14").Select

    
    Sheets("HOME").Select
    MsgBox ("PLANILHA " & CRIARNOVA & " CRIADA COM SUCESSO")
Exit Sub

MSGERRO:
MsgBox ("DATA SOLICITADA JÁ EXISTE, POR FAVOR REINICIE O PROCESSO")
    Sheets("MODELO TES (2)").Delete
    Sheets("MODELO TES").Visible = False
    Sheets("HOME").Select

End Sub
 

estou mandando uns prints da planilha pra você ver

obrigada mesmo

Macro.docx

[Basole]

Veja se esta sugestao lhe atende, juntar as duas macros "Aprovacao e Tesouraria"

Desta forma ja referencia o nome da nova aba criada na formula:

 

Sub CRIAR_NOVA()

'CRIA NOVA PLANILHA DE DIA AO FINAL

Dim CriaNovaAprovacao        As String
Dim CriaNovaTesouraria       As String

 ThisWorkbook.Activate
 
    On Error GoTo MSGERRO:
    CriaNovaAprovacao = InputBox("DIGITE A DATA DA PLANILHA A SER CRIADA(DDMM_APROVACAO)", _
                                "CRIANDO NOVA ABA APROVACAO", VBA.Format(VBA.Date, "ddmm") & "_APROVACAO")
    
          If CriaNovaAprovacao = "" Then MsgBox "Operacao Cancelada!", 64, "Aviso": Exit Sub
    
    Sheets("MODELO APROV").Visible = True
    Sheets("MODELO APROV").Select
    Sheets("MODELO APROV").Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
    
          ThisWorkbook.ActiveSheet.Name = CriaNovaAprovacao
    
    Sheets("MODELO APROV").Visible = False
    Sheets("HOME").Select
    MsgBox ("PLANILHA: " & CriaNovaAprovacao & " CRIADA COM SUCESSO")

If Err.Number <> 0 Then
MSGERRO:
  MsgBox ("DATA SOLICITADA JÁ EXISTE, POR FAVOR REINICIE O PROCESSO")
     With ThisWorkbook
        .Sheets("MODELO APROV (2)").Delete
        .Sheets("MODELO APROV").Visible = False
        .Sheets("HOME").Select
     End With
     
 On Error GoTo 0
Exit Sub

End If
                'CRIA NOVA PLANILHA TESOURARIA DE DIA AO FINAL

    On Error GoTo MSGERRO2:
    
    CriaNovaTesouraria = InputBox("DIGITE A DATA DA PLANILHA A SER CRIADA(DDMM_APROVACAO)", _
                                "CRIANDO NOVA ABA TESOURARIA", VBA.Format(VBA.Date, "ddmm") & "_TESOURARIA")
        
        If CriaNovaTesouraria = "" Then MsgBox "Operacao Cancelada!", 64, "Aviso": Exit Sub
        
      With ThisWorkbook
            .Sheets("MODELO TES").Visible = True
            .Sheets("MODELO TES").Select
            .Sheets("MODELO TES").Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
      End With
      
          ThisWorkbook.ActiveSheet.Name = CriaNovaTesouraria
        
    Sheets("MODELO TES").Visible = False
    
    With ActiveSheet
    
            .Range("E3:E13").Select
            Selection.ClearContents
            .Range("E3").Select
            ActiveCell.FormulaR1C1 = _
                "='" & CriaNovaAprovacao & "'!R[2]C[-2]+'" & CriaNovaAprovacao & "'!R[3]C[-2]"
            .Range("E4").Select
            ActiveCell.FormulaR1C1 = "='" & CriaNovaAprovacao & "'!R[3]C[-2]"
            .Range("E5").Select
            ActiveCell.FormulaR1C1 = _
                "='" & CriaNovaAprovacao & "'!R[7]C[-2]+'" & CriaNovaAprovacao & "'!R[8]C[-2]"
            .Range("E6").Select
            ActiveCell.FormulaR1C1 = "='" & CriaNovaAprovacao & "'!R[8]C[-2]"
            .Range("E7").Select
            ActiveCell.FormulaR1C1 = _
                "='" & CriaNovaAprovacao & "'!R[12]C[-2]+'" & CriaNovaAprovacao & "'!R[13]C[-2]"
            .Range("E8").Select
            ActiveCell.FormulaR1C1 = "='" & CriaNovaAprovacao & "'!R[13]C[-2]"
            .Range("E9").Select
            ActiveCell.FormulaR1C1 = _
                "='" & CriaNovaAprovacao & "'!R[17]C[-2]+'" & CriaNovaAprovacao & "'!R[18]C[-2]"
            .Range("E10").Select
            ActiveCell.FormulaR1C1 = "='" & CriaNovaAprovacao & "'!R[18]C[-2]"
            .Range("E11").Select
            ActiveCell.FormulaR1C1 = _
                "='" & CriaNovaAprovacao & "'!R[22]C[-2]+'" & CriaNovaAprovacao & "'!R[23]C[-2]"
            .Range("E12").Select
            ActiveCell.FormulaR1C1 = "='" & CriaNovaAprovacao & "'!R[23]C[-2]"
            .Range("E13").Select
            ActiveCell.FormulaR1C1 = "='" & CriaNovaAprovacao & "'!R[30]C[-2]"
            .Range("E14").Select
            ActiveWindow.LargeScroll Down:=1
            .Range("E40").Select
            ActiveWindow.LargeScroll Down:=-1
            .Range("E14").Select
End With
    
    Sheets("HOME").Select
    MsgBox ("PLANILHA: " & CriaNovaTesouraria & " CRIADA COM SUCESSO")
Exit Sub

MSGERRO2:
MsgBox ("DATA SOLICITADA JÁ EXISTE, POR FAVOR REINICIE O PROCESSO")
    With ThisWorkbook
        .Sheets("MODELO TES (2)").Delete
        .Sheets("MODELO TES").Visible = False
        .Sheets("HOME").Select
   End With
   
End Sub