Comparaison de deux feuilles et copie de certaines valeurs

Bonjour, j'ai besoin d'aide.

Ma BD en réel fait 200 000 lignes et RESULTAT fait environ 50 000lignes.

J'aimerai privilégier du vba par rapidité.

voir ma pj

le principe est celui ci :

Dans la feuille Résultat

si les ref (en A) dans RESULTAT sont présentes dans BD (en A)

alors je copie les valeurs (en rouge pour l'exemple) des colonnes (ici en bleu J,R,S,U,V pour l'exemple) de BD

vers RESULTAT (colonne bleu K,L,N,M,O pour l'exemple).

Merci pour votre aide.

Bonjour,

Une proposition.

Cdlt.

Public Sub Copy_data()
Dim ws As Worksheet, ws2 As Worksheet
Dim lastRow As Long, lRow As Long
Dim rw
    Application.ScreenUpdating = False
    Set ws = Worksheets("Résultat")
    Set ws2 = Worksheets("BD")
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    If lastRow > 1 Then
        For lRow = 2 To lastRow
            rw = Application.Match(ws.Cells(lRow, 1).Value, ws2.Columns(1), 0)
            If Not IsError(rw) Then
                ws.Cells(lRow, 11).Value = ws2.Cells(rw, 10).Value
                ws.Cells(lRow, 12).Value = ws2.Cells(rw, 18).Value
                ws.Cells(lRow, 13).Value = ws2.Cells(rw, 19).Value
                ws.Cells(lRow, 14).Value = ws2.Cells(rw, 21).Value
                ws.Cells(lRow, 15).Value = ws2.Cells(rw, 22).Value
            End If
        Next lRow
    End If
End Sub

Bonsoir,

Voici ma proposition

Sub test()
Dim DerLigne1, Derligne2 As Long, i%, ligne
Set WsS = Sheets("BD")
Set WsC = Sheets("resultat")
 Application.ScreenUpdating = False
    DerLigne1 = WsS.Range("A" & Rows.Count).End(xlUp).Row
    Derligne2 = WsC.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To Derligne2
        ligne = WsS.Range("A2:A" & DerLigne1).Find(WsC.Range("A" & i)).Row
            WsS.Range("J" & ligne).Copy Destination:=WsC.Range("K" & i)
            WsS.Range("R" & ligne).Copy Destination:=WsC.Range("L" & i)
            WsS.Range("S" & ligne).Copy Destination:=WsC.Range("M" & i)
            WsS.Range("U" & ligne).Copy Destination:=WsC.Range("N" & i)
            WsS.Range("V" & ligne).Copy Destination:=WsC.Range("O" & i)
    Next i
End Sub

cdt

Henri