Coletar Informações de outra Pasta

[Korgoth]

Bom dia, precisava de uma ajuda com uma macro que estou tentando fazer.

No caso eu terei uma planilha de busca (Consulta) com um campo para colocar manualmente 100 codigos

e ao clicar no botão *Buscar* ele iria coletar as informações correspondentes ao Codigo na coluna "Codigo" em uma outra pasta de trabalho completamente diferente que no exemplo seria a CadPeso e colar na coluna "G" em seus respectivos codigos.

[messiasmbm]

olha ai de novo vê se atende suas necessidades...

[Korgoth]

Código: Selecionar todos

Sub fncMain()
    'Creditos Walhart
    'Este código deverá ficar num módulo da pasta de trabalho de pedidos.

Application.ScreenUpdating = False

On Error GoTo ErrHandler:

    Dim lngPedido, lngLastPedido As Long
    Dim X, Y As Variant
    Dim wP, wksBD As Worksheet
   
   
    'Mude o caminho abaixo ou use Set wP = ActiveSheet
    Set wP = ThisWorkbook.Worksheets("Consulta")
    'Para a linha abaixo funcionar, coloque a pasta de trabalho de banco de dados
    'no mesmo diretório da pasta de trabalho de pedidos.
    Set wksBD = Workbooks.Open(ThisWorkbook.Path & "\CadPeso.XLSX").Worksheets("Peso")
   
    With wP
        lngLastPedido = .Cells(.Rows.Count, "F").End(xlUp).Row
    End With
   
    For lngPedido = 2 To lngLastPedido
   
        X = wP.Cells(lngPedido, 6).Value
       
        Y = Application.WorksheetFunction.VLookup(X, wksBD.Range("A:E"), 2, False)
        wP.Cells(lngPedido, 7).Value = Y
       
        Y = Application.WorksheetFunction.VLookup(X, wksBD.Range("A:E"), 3, False)
        wP.Cells(lngPedido, 8).Value = Y
       
        Y = Application.WorksheetFunction.VLookup(X, wksBD.Range("A:E"), 4, False)
        wP.Cells(lngPedido, 9).Value = Y
       
        Y = Application.WorksheetFunction.VLookup(X, wksBD.Range("A:E"), 5, False)
        wP.Cells(lngPedido, 10).Value = Y
       
    Next lngPedido
   
    wksBD.Parent.Close False
   
ErrHandler:
If Err.Number = 1004 Then
    Y = "N/C"
    Resume Next
End If
   
End Sub