Veja se conforme o que está neste topico viewtopic.php?f=10&t=4529 lhe atende

Oi Charlie,

Segue sua planilha já com o código implementado e funcionando.
Vou deixar o código aberto aqui na postagem, pras pessoas não terem que baixar o arquivo pra ver como faz.

Qto ao código, deve estar na folha de código da planilha cuja célula será alterada para "ativo"
Ah, explicando, eu nomeei as planilhas como "EP-fulano", pois há um limite de 31 caracteres para o nome de planilhas. Ou seja, para os funcionários, só aparecerá as 28 primeiras letras dos seus nomes, pq 3 letras são consumidas pelo "EP-". E para esclarecer, escolhi EP pq é abreviação de Espelho de Ponto.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo TratarErro
Dim shtRelacao  As Worksheet
Dim shtEspelho  As Worksheet
Dim rng         As Range

    Set shtRelacao = Target.Parent

    For Each rng In Target.Cells
        If rng.Column = 8 Then
            If rng.Value = "ativo" Then
                If Not fnPlanilhaJaExiste("EP-" & shtRelacao.Range("A" & rng.Row).Value) Then
                    If MsgBox("Este funcionário não tem planilha de ponto." & vbCrLf & "Deseja criar uma agora?", vbYesNo + vbQuestion) = vbYes Then
                        
                        With ThisWorkbook
                            .Worksheets("espelho de ponto individual").Copy After:=.Worksheets(.Worksheets.Count)
                            Set shtEspelho = .Worksheets(.Worksheets.Count)
                        End With
                        
                        With shtEspelho
                            .Name = VBA.Left("EP-" & shtRelacao.Range("A" & rng.Row).Value, 31)
                            .Range("B4").Value = shtRelacao.Range("A" & rng.Row).Value
                        End With
                        
                    End If
                End If
            End If
        End If
    Next rng
    
    Set shtEspelho = Nothing
    Set shtRelacao = Nothing
    Set rng = Nothing
    
Exit Sub
TratarErro:
    MsgBox "Deu erro.", vbCritical + vbOKOnly, "Erro"
End Sub

Public Function fnPlanilhaJaExiste(strNome As String) As Boolean
On Error Resume Next
Dim sht As Worksheet
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name = strNome Then
            fnPlanilhaJaExiste = True
            Exit Function
        End If
    Next sht
End Function

Qualquer coisa é só gritar! Abraço

PERFEITO "fernando.fernandes"
vLWS D++++

Oi Charlie,

Segue sua planilha já com o código implementado e funcionando.
Vou deixar o código aberto aqui na postagem, pras pessoas não terem que baixar o arquivo pra ver como faz.

Qto ao código, deve estar na folha de código da planilha cuja célula será alterada para "ativo"
Ah, explicando, eu nomeei as planilhas como "EP-fulano", pois há um limite de 31 caracteres para o nome de planilhas. Ou seja, para os funcionários, só aparecerá as 28 primeiras letras dos seus nomes, pq 3 letras são consumidas pelo "EP-". E para esclarecer, escolhi EP pq é abreviação de Espelho de Ponto.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo TratarErro
Dim shtRelacao  As Worksheet
Dim shtEspelho  As Worksheet
Dim rng         As Range

    Set shtRelacao = Target.Parent

    For Each rng In Target.Cells
        If rng.Column = 8 Then
            If rng.Value = "ativo" Then
                If Not fnPlanilhaJaExiste("EP-" & shtRelacao.Range("A" & rng.Row).Value) Then
                    If MsgBox("Este funcionário não tem planilha de ponto." & vbCrLf & "Deseja criar uma agora?", vbYesNo + vbQuestion) = vbYes Then
                        
                        With ThisWorkbook
                            .Worksheets("espelho de ponto individual").Copy After:=.Worksheets(.Worksheets.Count)
                            Set shtEspelho = .Worksheets(.Worksheets.Count)
                        End With
                        
                        With shtEspelho
                            .Name = VBA.Left("EP-" & shtRelacao.Range("A" & rng.Row).Value, 31)
                            .Range("B4").Value = shtRelacao.Range("A" & rng.Row).Value
                        End With
                        
                    End If
                End If
            End If
        End If
    Next rng
    
    Set shtEspelho = Nothing
    Set shtRelacao = Nothing
    Set rng = Nothing
    
Exit Sub
TratarErro:
    MsgBox "Deu erro.", vbCritical + vbOKOnly, "Erro"
End Sub

Public Function fnPlanilhaJaExiste(strNome As String) As Boolean
On Error Resume Next
Dim sht As Worksheet
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name = strNome Then
            fnPlanilhaJaExiste = True
            Exit Function
        End If
    Next sht
End Function

Qualquer coisa é só gritar! Abraço

fernando.fernandes, fantástico cara. Deve ser algo muito simples para quem tem tamanho conhecimento néh? Enfim, agradeço não só pela resposta mas também pela rapidez da mesma. Outra coisa, e para que esta planilha seja excluída quando o funcionário receber o status de "Desligado", como ficaria o código?

Oi Charlie,

Segue sua planilha já com o código implementado e funcionando.
Vou deixar o código aberto aqui na postagem, pras pessoas não terem que baixar o arquivo pra ver como faz.

Qto ao código, deve estar na folha de código da planilha cuja célula será alterada para "ativo"
Ah, explicando, eu nomeei as planilhas como "EP-fulano", pois há um limite de 31 caracteres para o nome de planilhas. Ou seja, para os funcionários, só aparecerá as 28 primeiras letras dos seus nomes, pq 3 letras são consumidas pelo "EP-". E para esclarecer, escolhi EP pq é abreviação de Espelho de Ponto.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo TratarErro
Dim shtRelacao  As Worksheet
Dim shtEspelho  As Worksheet
Dim rng         As Range

    Set shtRelacao = Target.Parent

    For Each rng In Target.Cells
        If rng.Column = 8 Then
            If rng.Value = "ativo" Then
                If Not fnPlanilhaJaExiste("EP-" & shtRelacao.Range("A" & rng.Row).Value) Then
                    If MsgBox("Este funcionário não tem planilha de ponto." & vbCrLf & "Deseja criar uma agora?", vbYesNo + vbQuestion) = vbYes Then
                        
                        With ThisWorkbook
                            .Worksheets("espelho de ponto individual").Copy After:=.Worksheets(.Worksheets.Count)
                            Set shtEspelho = .Worksheets(.Worksheets.Count)
                        End With
                        
                        With shtEspelho
                            .Name = VBA.Left("EP-" & shtRelacao.Range("A" & rng.Row).Value, 31)
                            .Range("B4").Value = shtRelacao.Range("A" & rng.Row).Value
                        End With
                        
                    End If
                End If
            End If
        End If
    Next rng
    
    Set shtEspelho = Nothing
    Set shtRelacao = Nothing
    Set rng = Nothing
    
Exit Sub
TratarErro:
    MsgBox "Deu erro.", vbCritical + vbOKOnly, "Erro"
End Sub

Public Function fnPlanilhaJaExiste(strNome As String) As Boolean
On Error Resume Next
Dim sht As Worksheet
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name = strNome Then
            fnPlanilhaJaExiste = True
            Exit Function
        End If
    Next sht
End Function

Qualquer coisa é só gritar! Abraço

Oi Charlie, eu q agradeço a oportunidade de ajudar.

Seguinte, quanto à outra solicitação, sugiro que crie um outro tópico pq é outro assunto.
Um é criar planilhas, o outro é excluir planilhas.

Já estou com a solução na cabeça, assim que eu ver o tópico criado, eu respondo lá.
O motivo principal é facilitar buscas futuras por membros que utilizarão os campos de pesquisa para encontrarem o que precisam.

Valeu!

O novo tópico foi criado. Agradeço pela atenção.

viewtopic.php?f=16&t=4709