Notifications
Clear all

criar pastas em uma planilha.

5 Posts
2 Usuários
0 Reactions
2,292 Visualizações
(@wellington_parreiras)
Posts: 33
Trusted Member
Topic starter
 

Boa tarde a todos.
Preciso criar uma macro com a seguinte ação:
Quando for digitado um códico qualquer na linha A1, a macro verifique se existe uma pasta com este nome. caso ela encontre, ela irá abrir caso contrario, aparecera uma pergunta se eu desejo criar uma nova pasta. se a resposta for OK, a macro cria uma pasta no final da planilha, com o nome do código digitado na linha A1.

 
Postado : 23/02/2012 12:57 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bem-vindo ao Planilhando, Wellington...!

Um pouco confusas as referências... mas, se eu não estiver enganado, estamos tratando de apenas um arquivo com várias guias.

Teste o código abaixo e verifique se é o que pretende. Caso contrário, explique um pouco melhor, pois pode haver confusão ao se referir a linha A1, pasta, planilhas...

Clique com o botão direito sobre o nome da guia base/Exibir código e cole o código abaixo:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sh As Worksheet

If Target.Address <> Range("A1").Address Then
Exit Sub
Else
g = Target.Value

For Each sh In Worksheets
If sh.Name = g Then
sh.Activate
Exit Sub
End If
Next

x = MsgBox("Deseja criar uma nova guia?", vbYesNo)
    If x = 6 Then
    Sheets.Add
    ActiveSheet.Name = g
    Sheets(g).Move After:=Sheets(Sheets.Count)
    Exit Sub
    End If

End If

End Sub
 
Postado : 23/02/2012 9:06 pm
(@wellington_parreiras)
Posts: 33
Trusted Member
Topic starter
 

Edson,
Muito obrigado pela atenção.
O código que você forneceu está bem próximo do que eu estou precisando.
Estou enviando uma planilha como modelo e vou tentar explicar um pouco melhor.

Na pasta "Principal" da planilha Teste.xls (em anexo) possui uma referencia "F5" que serve para entrar com um código que se deseja lançar determinadas informações.
Se no campo "F5" for digitado 1500 (por exemplo), ao clicar no botão "PESQUISAR" deve-se abrir a pasta "1500" para que se possa lançar os valores referentes a este código.
Se a pasta não existir, entrar com a pergunta "O CÓDIGO NÃO EXISTE, DESEJA CRIA-LO?" se a resposta for "NÃO", a macro retorna a referencia "F5" e se for "SIM", ela irá duplicar a pasta "MODELO" e renomea-la com o novo código digitado na linha "F5" .
Espero que tenha explicado um pouco melhor.
Desde já agradeço pela ajuda.

Atenciosamente,

Wellington

 
Postado : 24/02/2012 8:17 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Wellington, fazendo uma adaptação no código fornecido pelo Edson, transformei a mesma em duas, são praticamente iguais, o que difere uma da outra é :
Uma, é para ser utilizada no Evento "Worksheet_Change", ou seja, a rotina executará ao alterarmos qualquer célula, sem precisar clicar em Pesquisar e somente será valida se a alteração for no range expecifico "F5".

A outra, associamos ao Botão pesquisar, e só rodará apos clicarmos no mesmo.

EVENTO DA ABA

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim sh As Worksheet
    Dim g As Variant
    
    'Verfica se a celula alterada é a F5
    'se não for sai da rotina
    If Target.Address <> Range("F5").Address Then
        Exit Sub
    
    Else
        
        g = Target.Value
        
        'Verifica se o valor é nulo
        If g = "" Then
                MsgBox "Digite um Código", vbCritical, "Código Obrigatório"
                Target.Activate
            Exit Sub
        End If
        
        For Each sh In Worksheets
            If sh.Name = g Then
                    sh.Activate
                Exit Sub
            End If
        Next
    
        x = MsgBox("Deseja criar uma nova guia?", vbYesNo)
        
        If x = 6 Then
                'Copia a aba Modelo e renomeia
                Sheets("Modelo").Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = g
            Exit Sub
        Else
            'Se cancelado, seleciona F5
            Target.Activate
        End If
    
    End If

End Sub

ASSOCIAR AO BOTÃO :

Sub PesquisarCriar()
    Dim sh As Worksheet
    Dim g As Variant
    
        If Range("F5").Value = "" Then
            MsgBox "Digite um Código", vbCritical, "Código Obrigatório"
            Range("F5").Activate
        Exit Sub
    
    Else
    
        g = [F5]
    
        For Each sh In Worksheets
            If sh.Name = g Then
                    sh.Activate
                Exit Sub
            End If
        Next
    
        x = MsgBox("Deseja criar uma nova guia?", vbYesNo)
    
        If x = 6 Then
                Sheets("Modelo").Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = g
            Exit Sub
        Else
            Range("F5").Activate
        End If
    
    End If
End Sub

[]S

 
Postado : 24/02/2012 7:49 pm
(@wellington_parreiras)
Posts: 33
Trusted Member
Topic starter
 

Mauro Coutinho, muito obrigado.
Eu fiz um pequeno ajuste para adequar à minha necessidade, e esta rodando 100%, problema resolvido.
Agradeço a todos que contribuiram para a resolução deste meu problema.
Um agradecimento especial para o Edson e para o Mauro Coutinho.

Atenciosamente,

Wellington.

 
Postado : 27/02/2012 7:43 am