Excel Duplicar Planilha e Nomear com Data

[mortão]

Estou Tentado criar uma macro que, duplique uma planilha base, com todas a formatação e nomeia com a data do dia (08/08/2021), porém se tiver uma outra duplicação no mesmo dia, nomear com (08/08/2021 (2)) e assim por diante. Mas a macro que montei, quando duplico as próximas do dia, esta sendo nomeada com o nome que dei para a planilha que uso de base, que nomeie de Base. Ficando assim (08/08/2021), a próxima (Base (2)) ..... 

 

Segue a macro.

 

Sub NovaPlanilha_Morto()
Dim pn As Worksheet
Dim pb As Worksheet
Dim i As Integer
Dim nome As String
Dim pv As Integer

'Legenda pn= Planilha Nova, pb= Planilha Base, pv= Planilha Verificada.

On Error Resume Next ' Sempre coloque aqui em cima essa declaração e não no meio, combinado?
' Ela significa que se tiver um erro ela passa para a próxima instrução ou macro, então coloque ela sempre após declarar as ' variáveis
    
    'Define a Planilha BASE, BASE é o nome da planilha
    'Set pb = ActiveSheet
    'Se quiser que abra uma planilha específica ponha:Set pb = Sheets("nome da planilha")
    Set pb = Sheets("Base")
    'Congela a tela
    Application.ScreenUpdating = False
    
    'Nome da nova Planilha
    nome = Format(Date, "dd-mm-yyyy")
    
    'Conta quantidades de planilhas
    i = Worksheets.Count
    
    'Copia a planilha atual ou uma especifica após a pultima aba
    pb.Copy After:=Worksheets(i)
        i = i + 1
        
    'Declaramos a nova planilha e renomeamos
    Set pn = Worksheets(i)
        With pn
        .Name = nome
        .Range("A1").Select
        End With
    Application.CutCopyMode = False
    
'Tentativa de renomear data (2),(3)....
    
    'Percorre todas as planilhas existentes
    For i = 1 To Sheets.Count Step 1
        'Verifica os nomes das planilhas
        If Sheets(i).Name = "Base" And pn = 0 Then
            'Define que foi encntada uma planilha com nome Base
            pn = 1
        ElseIf Sheets(i).Name Like "Base (*)" Then
            'Pega o número que está entre os parênteses
            pv = CInt(Mid(Sheets(i).Name, 6, Len(Sheets(i).Name) - 6))
            ' Verifica o número da planilha atual com o número da última encontrada
            If pv > pn Then
                'Define o número da última planilha encontrada
                pn = pv
            End If
        End If
    Next i
    
    'Selecina a planilha atual
    Sheets(Sheets.Count).Select
    'Verifica qual o nome deverá ser considerado
    If pn = 0 Then
        Sheets(Sheets.Count).Name = nome
    Else
        Sheets(Sheets.Count).Name = nome & (CStr(pn + 1))
    End If
    
    'Ativa a atualização de tela
    Application.ScreenUpdating = True

End Sub

 

[Midori]

@mortão Acho mais fácil criar uma função para testar se a planilha já existe. Aí é só fazer um loop para ir incrementando um índice até chegar no nome que ainda não existe, p.ex,

 

Sub Duplica()
    Dim Nova    As Worksheet
    Dim Indice  As Integer
    Dim Nome    As String
        
    Set Nova = ThisWorkbook.Sheets("Base")
        Nova.Copy ThisWorkbook.Sheets(1)
    Set Nova = ThisWorkbook.Sheets(1)
    
    Nome = Format(Date, "dd-mm-yyyy")
    
    While PlanExiste(Nome)
        Indice = Indice + 1
        Nome = Format(Date, "dd-mm-yyyy") & _
            " (" & Indice & ")"
    Wend
    Nova.Name = Nome
End Sub

 

[Muca Costa]

Tente assim:

DE: nome = Format(Date, "dd-mm-yyyy")

PARA: Nome = Format(Now(), "dd-mm-yyyy hh mm ss")

[mortão]

Em 09/08/2021 às 10:47, Midori disse:

PlanExiste

Obrigado Midori, mas acabou dando um erro nessa linha pedindo um "SUB"  ou "Function", ainda não tive tempo de estudar o  caso.

[Midori]

@mortão Essa função pode ser assim,

 

Function PlanExiste(ByVal Nome As String) As Boolean
    Dim Tmp As String
    On Error GoTo FIM
    Tmp = ThisWorkbook.Sheets(Nome).Name
FIM:
    PlanExiste = (Not Err.Number = 9)
End Function

 

Assim a linha da atribuição de Tmp vai gerar o erro 9 se a aba Nome não existir e com a instrução On Error temos o controle para retornar True ou False.

[mortão]

Em 09/08/2021 às 16:07, Muca Costa disse:

Tente assim:

DE: nome = Format(Date, "dd-mm-yyyy")

PARA: Nome = Format(Now(), "dd-mm-yyyy hh mm ss")

Obrigado pela resposta Muca, cara realmente renomeou as abas e resolveu com data e horas. Seria um solução temporária, mas eu gostaria de chegar no resultado de (2), (3), .....

[mortão]

Em 11/08/2021 às 12:33, Midori disse:

@mortão Essa função pode ser assim,

 

Function PlanExiste(ByVal Nome As String) As Boolean
    Dim Tmp As String
    On Error GoTo FIM
    Tmp = ThisWorkbook.Sheets(Nome).Name
FIM:
    PlanExiste = (Not Err.Number = 9)
End Function

 

Assim a linha da atribuição de Tmp vai gerar o erro 9 se a aba Nome não existir e com a instrução On Error temos o controle para retornar True ou False.

 

Cara vou confessar que não entendo nada de vba comecei a estudar agora, tenho um conhecimento em algoritmo... em fim, não consegui usar seu codigo, tentei de varias forma e sempre da erro de "era esperado um End sub" não sei se é erro de sintax, mas vou continuar tentando.

Sub Duplica()
    Dim Nova    As Worksheet
    Dim Indice  As Integer
    Dim Nome    As String
    Function PlanExiste(ByVal Nome As String) As Boolean
    Dim Tmp As String
    On Error GoTo FIM
        
        
    Set Nova = ThisWorkbook.Sheets("Base")
        Nova.Copy ThisWorkbook.Sheets(1)
    Set Nova = ThisWorkbook.Sheets(1)
    
    Nome = Format(Date, "dd-mm-yyyy")
    
    While PlanExiste(Nome)
        Indice = Indice + 1
        Nome = Format(Date, "dd-mm-yyyy") & _
            " (" & Indice & ")"
    
    Wend
    Nova.Name = Nome
    
    Tmp = ThisWorkbook.Sheets(Nome).Name
FIM:
    PlanExiste = (Not Err.Number = 9)
     End Function
End Sub

 

Éssa é uma das minhas tentativas

[Midori]

São dois procedimentos (Sub e Function), cada um com seus comandos e variáveis locais. Não precisa tentar mudar nada, é só copiar cada um como está e colar no módulo.

 

Da forma como fez colou partes da função dentro da sub e assim não vai rodar mesmo.

[mortão]

Entendi, coloquei cada código em um modulo e funcionou, era quase o resultado que eu esperava, se não por um detalhe. As nova planilha criada estão ficando antes da Planilha base, a esquerda e não a direita como padrão. Se tiver alguma forma de mudar isso. 

[Midori]

Para deixar a nova planilha sempre ao lado da Base a direita,

Nova.Move After:=ThisWorkbook.Sheets("Base")

 

Ou se quiser deixar sempre na última posição a direta,

Nova.Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

 

[mortão]

Cara amigo Midori a cada post seu tem sido um aprendizado em minha vida! Obrigado!

 

O código para deixar a planilha criada sempre na última posição encachou perfeitamente no meu objetivo.

Nova.Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

Por assim sendo, obrigado a contribuição de todos!!!