Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Duplicar e renomear...
 
Notifications
Clear all

Duplicar e renomear Guia

 
2024 - VBA & Macros
Post Recente por fpheldman 9 anos atrás
8 Posts
2 Usuários
0 Reactions
2,231 Visualizações
RSS
 fpheldman
(@fpheldman)
Posts: 26
Eminent Member
Topic starter
 

Boa tarde!

Estou com uma dificuldade, consegui o código VBA para copiar uma determinada guia com o nome "NAOMEXER", na qual ela originalmente deve ser oculta.
O código abaixo torna a guia "NAOMEXER" visivel, faz uma cópia para o final e a oculta novamente, porém estou tendo algumas dificuldades.
Ao executar a macro abre a caixa de texto para digitar o nome da nova guia, se eu clicar em Cancelar dá erro e cria uma guia com o nome "NAOMEXER(2)".
Acontece também quando digito um nome de guia já existente na planilha. Percebi (por ultimo) que o código renomeia a nova guia, porém depois de alguma guias criadas ele torna a criar a nova guia com o nome "NAOMEXER(2)" sem apresentar nenhum erro. Alguma ajuda?

Sub DuplicaERenomeia()
'primeiro, faz a cópia da planilha
    Sheets("NAOMEXER").Visible = True
    Sheets("NAOMEXER").Copy After:=Sheets(ThisWorkbook.Worksheets.Count)
    'como foi movida para o final, pega a última
    Dim newSheet As Worksheet
    Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    newSheet.Name = InputBox("Prefixo do TREM:", "Renomeando...", newSheet.Name)
    MsgBox "Nova guia com check list do TREM criada!"
    Sheets("NAOMEXER").Visible = False
End Sub
 
Postado : 08/08/2015 2:03 pm
 rlaf
(@rlaf)
Posts: 10
Active Member
 

Amigo,

Veja se ajuda.

Sub DuplicaERenomeia()
'primeiro, faz a cópia da planilha

Dim newSheet As Worksheet
Dim nome As String
Dim bool As Boolean

nome = InputBox("Prefixo do TREM:", "Renomeando...")

For Each abc In Worksheets
If abc.Name = nome Then
bool = True
End If
Next

If bool = False Then

    Sheets("NAOMEXER").Visible = True
    Sheets("NAOMEXER").Copy After:=Sheets(ThisWorkbook.Worksheets.Count)
    Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    newSheet.Name = nome
    MsgBox "Nova guia com check list do TREM criada!"
    Sheets("NAOMEXER").Visible = False
Else
    MsgBox "Já existe uma guia com o nome: [" & nome & "].", vbCritical, "Atenção"
    
End If
    
End Sub

At.
Ricardo

http://xlssolution.blogspot.com.br/

 
Postado : 08/08/2015 6:44 pm
 fpheldman
(@fpheldman)
Posts: 26
Eminent Member
Topic starter
 

Bom dia Ricardo! Desde já muito obrigado pela resposta.
Quando digito o nome da nova guia, no caso "Prefixo do trem" na caixa, continua criando a guia no final (correto) porém com nome NAOMEXER(2), que é como se fosse uma cópia do nome da guia original NAOMEXER.

O sistema de proteção deu certo, quanto digito um nome já existente o código diz que já existe um nome igual.
Porém, quando clico em cancelar dá erro na linha seguinte:

 
Postado : 09/08/2015 3:28 am
 rlaf
(@rlaf)
Posts: 10
Active Member
 

Olá.

esqueci de verificar isso.

É só colocar esse IF.

Sub DuplicaERenomeia()
'primeiro, faz a cópia da planilha

Dim newSheet As Worksheet
Dim nome As String
Dim bool As Boolean

nome = InputBox("Prefixo do TREM:", "Renomeando...")

For Each abc In Worksheets
If abc.Name = nome Then
bool = True
End If
Next

'--------------------------------
If nome = "" Then
Exit Sub
End If
'--------------------------------

If bool = False Then

    Sheets("NAOMEXER").Visible = True
    Sheets("NAOMEXER").Copy After:=Sheets(ThisWorkbook.Worksheets.Count)
    Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    newSheet.Name = nome
    MsgBox "Nova guia com check list do TREM criada!"
    Sheets("NAOMEXER").Visible = False
Else
    MsgBox "Já existe uma guia com o nome: [" & nome & "].", vbCritical, "Atenção"
    
End If
    
End Sub

At.
Ricardo

http://xlssolution.blogspot.com.br/

 
Postado : 09/08/2015 9:24 am
 fpheldman
(@fpheldman)
Posts: 26
Eminent Member
Topic starter
 

Ricardo boa tarde!
O "sistema de segurança" ficou show de bola, funcionamento bacana. O único problema que ainda não consegui resolver foi renomear a guia com o nome que coloquei na caixa.
Continua "NAOMEXER2(2)", "NAOMEXER2(3)", etc

 
Postado : 09/08/2015 11:28 am
 rlaf
(@rlaf)
Posts: 10
Active Member
 

Realmente não sei o que esta ocorrendo.

Na minha maquina esta funcionando correto.

Você esta usando o ultimo código que postei?

At.
Ricardo

 
Postado : 09/08/2015 2:27 pm
 fpheldman
(@fpheldman)
Posts: 26
Eminent Member
Topic starter
 

Vou fazer os testes fora do desktop, no notebook e volto com o retorno.

 
Postado : 09/08/2015 3:16 pm
 fpheldman
(@fpheldman)
Posts: 26
Eminent Member
Topic starter
 

Ricardo bom dia!
Refiz os teste no meu notebook hoje e diferente do desktop realmente o código funcionou perfeitamente!
Muito obrigado pela ajuda!

 
Postado : 10/08/2015 10:09 am
Forum Jump:
  Tópico Anterior
Próximo Tópico