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
Postado : 22/06/2012 5:33 pm