Não entendo nem imagino pq razão vc iria querer reescrever o PROCV via VBA. Mas não vou entrar neste mérito.
Eu traduzi seu código, usando a mesma lógica, mas ao invés de usar o Cells(), eu usei usando matrizes. Não é a melhor forma de fazer, mas num primeiro momento, vc vai ver o ganho absurdo de desempenho. O que quero dizer com isso, sim, é possível deixar ainda mais rápido. Mas pra seu objetivo de melhorar desempenho, essa melhora já atende e muito. Substitua seu código por esse.
Qualquer dúvida, me avisa!

Option Explicit

Sub Busca()
Dim plDados As Worksheet
Dim mtDados As Variant
Dim lDados  As Long     'linhas
Dim cDados  As Long     'colunas

Dim plTeste As Worksheet
Dim mtTeste As Variant
Dim lTeste  As Long     'linhas
Dim cTeste  As Long     'colunas

Dim i       As Long
Dim j       As Long

'Define as Sheets
    Set plTeste = Sheets("Pedidos")
    Set plDados = Sheets("Dados")
    
    'Limite da busca
    With plTeste
        lTeste = .Cells(.Rows.Count, 1).End(xlUp).Row
        cTeste = 5
        mtTeste = .Range(.Cells(1, 1), .Cells(lTeste, cTeste)).Value
    End With
    With plDados
        lDados = .Cells(.Rows.Count, 1).End(xlUp).Row
        cDados = 6
        mtDados = .Range(.Cells(1, 1), .Cells(lDados, cDados)).Value
    End With
    
    i = 2

    Do While (i <> lTeste + 1)

        For j = 2 To lDados
        
            If mtTeste(i, 1) = mtDados(j, 1) Then
               mtTeste(i, 2) = mtDados(j, 2)
               mtTeste(i, 3) = mtDados(j, 3)
               mtTeste(i, 4) = mtDados(j, 5)
                                  
               j = lDados + 1
        
             End If
        Next j
        
        i = i + 1

    Loop
    With plTeste
        .Range(.Cells(1, 1), .Cells(lTeste, cTeste)).Value = mtTeste
    End With
End Sub

Ficou perfeito, somente um detalhe que eliminou uma tabela "dinâmica" que tinha na planilha, como resolvo isso?

Vc não tinha mencionado nada de dinâmica...
Aonde ela estava? O ideal seria vc postar o arquivo com a dinâmica, preu ver o q houve... Este código atende a dúvida no arquivo q vc postou, q tb não tem dinâmica....

me perdoe, é uma tabela somente e não dinamica, o arquivo anexado esta com a tabela, a onde o codigo sera executado...

Poste novo modelo então, com a tabela intacta. Eu adapto pra que ela não desapareça.

Segue o anexo...

use esse:

Option Explicit

Sub Busca()
Dim plDados As Worksheet
Dim mtDados As Variant
Dim lDados  As Long     'linhas
Dim cDados  As Long     'colunas

Dim plTeste As Worksheet
Dim mtTeste As Variant
Dim lTeste  As Long     'linhas
Dim cTeste  As Long     'colunas

Dim i       As Long
Dim j       As Long

'Define as Sheets
    Set plTeste = Sheets("Pedidos")
    Set plDados = Sheets("Dados")
    
    'Limite da busca
    With plTeste
        lTeste = .Cells(.Rows.Count, 1).End(xlUp).Row
        cTeste = 5
        mtTeste = .Range(.Cells(2, 1), .Cells(lTeste, cTeste)).Value
    End With
    With plDados
        lDados = .Cells(.Rows.Count, 1).End(xlUp).Row
        cDados = 6
        mtDados = .Range(.Cells(2, 1), .Cells(lDados, cDados)).Value
    End With
    
    For i = 2 To lTeste - 1

        For j = 2 To lDados - 1
        
            If mtTeste(i, 1) = mtDados(j, 1) Then
               mtTeste(i, 2) = mtDados(j, 2)
               mtTeste(i, 3) = mtDados(j, 3)
               mtTeste(i, 4) = mtDados(j, 5)
                                  
               j = lDados + 1
        
             End If
        Next j
    Next i
    
    With plTeste
        .Range(.Cells(2, 1), .Cells(lTeste, cTeste)).Value = mtTeste
    End With

End Sub

Fecho, deu certo, muito obrigado....