Este fórum está sendo desativado

[Inovacao]

Boa tarde, pessoal!!

Tenho uma planilha de controle do ponto, que na tela de PONTO ao selecionar o FUNCIONÁRIO e clicar em ATUALIZAR ele pega as horas que estão lançadas na plan de horas referente ao funcionário selecionado e joga para essa tela.

Tudo funcionava perfeitamente até eu acrescentar + 4 linhas em cada tela, ai parou de funcionar alguém consegue me ajudar?

Segue Planilha

Obrigado!!

[mucascosta]

Com senha no VBA fica difícil! ...

[Inovacao]

Boa tarde, mucascosta!!

Desculpe pelo equivoco, segue novamente!!

Obrigado!!

[mucascosta]

Está confuso:
Onde vc seleciona o funcionário?
Veja que a validação de dados apresenta erro nas duas abas...

[Inovacao]

Boa noite, mucascosta!!

Segue novamente a Planilha gora funcionando.

Faça o teste na planilha da forma que enviei e depois insira linhas na plan folha do ponto e controle de horas e voce vai ver que a macro para de funcionar.

Referente a sua pergunta aonde eu seleciono o funcionário é na tela de FOLHA DO PONTO, segue imagem com a validação.

Obrigado!!

[mucascosta]

Tente essa macro:

Código: Selecionar todos

Sub Filtrar()
Dim P As String, B As String
    Sheets("Folha de Ponto").Select
    With ActiveSheet
        P = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
    If P > 23 Then
    Range("A24:K" & P).Select
    Selection.ClearContents
    End If
    
    Sheets("Controle de Horas").Select
    With ActiveSheet
        B = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    Range("A5:K" & B).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Planilha4.Range( _
        "C8:C9"), CopyToRange:=Planilha4.Range("A23:K23"), Unique:=False
    Sheets("Folha de Ponto").Select
    Range("B23").Select
    MsgBox "Filtro filnalizado"
End Sub

[Inovacao]

Bom dia, mucascosta!!

Não deu certo!!

Segue Planilha com o seu código inserido.

[mucascosta]

Segue, em anexo, funcionando...

[Inovacao]

Boa noite!!

Fiz o teste e deu tudo certo.

Porem ao acrescentar novas linhas na tela de lançamentos e na tela de folha do ponto ela apresentou erro, então pergunto no caso se eu precisar acrescentar mais linhas, em que parte do código precisarei alterar, voce pode me passar por favor?

Segue Planilha com a inclusão de novas linhas caso queira analisar.

Muito obrigado!!

[mucascosta]

Veja se essas alterações resolve:

Código: Selecionar todos

Sub Filtrar()
Dim P As String, PT As String, PC As String, B As String, BT As String
    Sheets("Folha de Ponto").Select
    Titulo
    Criterio
    With ActiveSheet
        P = .Cells(.Rows.Count, "B").End(xlUp).Row
        PT = Range("B1")
        PC = Range("C1")
    End With
    If P > PT Then
    Range("A" & PT + 1 & ":K" & P).Select
    Selection.ClearContents
    End If
    
    Sheets("Controle de Horas").Select
    Titulo
    With ActiveSheet
        B = .Cells(.Rows.Count, "A").End(xlUp).Row
        BT = Range("B1")
    End With
    Range("A" & BT & ":K" & B).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Planilha4.Range( _
        "C" & PC & ":C" & PC + 1), CopyToRange:=Planilha4.Range("A" & PT & ":K" & PT), Unique:=False
    Sheets("Folha de Ponto").Select
    MsgBox "Controle de horas do " & Range("C" & PC + 1) & " finalizado", vbInformation, "© Muca Sistemas - 2021"
    Range("C" & PC + 1).Select

End Sub

Sub Titulo() 'Busca a primeira linha com títulos de colunas
Range("A1").Select ' seleciona a primera linha da coluna a ser analisada
    Do Until ActiveCell = "Nome" ' executa a macro até encontrar a palavra Nome no fim da coluna a ser analisada
        ActiveCell.Offset(1, 0).Select 'desce uma linha
        If ActiveCell = "Nome" Then   'faz a análise lógica
            myRow = ActiveCell.Row
            Range("B1") = myRow
    End If
Loop
End Sub

Sub Criterio() 'Busca o interválo de critério
Range("C1").Select ' seleciona a primera linha da coluna a ser analisada
    Do Until ActiveCell = "Nome" ' executa a macro até encontrar a palavra Nome no fim da coluna a ser analisada
        ActiveCell.Offset(1, 0).Select 'desce uma linha
        If ActiveCell = "Nome" Then   'faz a análise lógica
            myRow = ActiveCell.Row
            Range("C1") = myRow - 1
    End If
Loop
End Sub

[Inovacao]

Boa tarde, mucascosta!!

Não deu certo, pois ficou rodando e não parava nunca, tive que foçar a parada da Planilha.

Segue Planilha em anexo.

Obrigado!!

[mucascosta]

Testei aqui e funcionou sem problemas. Tente novamente.

[mucascosta]

Em anexo

[Inovacao]

Boa tarde!!

Agora deu certo, qualquer coisa eu te dou um grito.

Obrigado pelo empenho em me ajudar, Muito obrigado!!

Sucesso!!