Veja se assim atende

Sub Copiar()
Dim ks As Integer
Dim i As Integer, Qtde As Integer
   Application.ScreenUpdating = False
    Sheets("funcionarios").Select
    Qtde = [B7].CurrentRegion.Rows.Count
    ks = 3
    For i = 2 To Qtde
    
    If Sheets("funcionarios").Cells(i, "F").Value = Sheets("aplub").Range("A1").Value Then
            Sheets("aplub").Cells(ks, "A").Value = Sheets("Funcionarios").Cells(i, "A").Value
            Sheets("aplub").Cells(ks, "B").Value = Sheets("Funcionarios").Cells(i, "B").Value
            Sheets("aplub").Cells(ks, "C").Value = Sheets("Funcionarios").Cells(i, "C").Value
            Sheets("aplub").Cells(ks, "D").Value = Sheets("Funcionarios").Cells(i, "D").Value
            Sheets("aplub").Cells(ks, "E").Value = Sheets("Funcionarios").Cells(i, "E").Value
            ks = ks + 1
        End If
    Next
    Sheets("aplub").Activate
    Application.ScreenUpdating = True
End Sub

Reinaldo,

muito grato pelo sua ajuda.
Abraços

Marcelo, favor leia as regras do forum, no quesito título.

desculpe minha falha
onde fecho o topico como RESOLVIDO

marquei para você