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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 24/02/2012 7:49 pm