[RESOLU] Copier cellule suivant liste

Option Explicit

Sub Macro1()
    Dim tableauRef() As Variant
    Dim nbRef As Long
    Dim X As Long, Y As Long
    Dim nbLignes As Long
    
    ' On dimensionne le tableau
    nbRef = Sheets("Liste Réf").Cells(Rows.Count, 1).End(xlUp).Row - 1
    ReDim tableauRef(nbRef, 4)
    ' On charge le tableau
    For Y = 1 To nbRef
        For X = 1 To 4
            tableauRef(Y, X) = Sheets("Liste Réf").Cells(Y + 1, X)
        Next X
    Next Y
    
    ' On calcule le nombre de lignes du tableau à remplir
    nbLignes = Cells(Rows.Count, 2).End(xlUp).Row - 2
    For Y = 1 To nbLignes
        For X = 1 To UBound(tableauRef)
            If Cells(Y + 2, 2) = tableauRef(X, 1) Then
                Cells(Y + 2, 3) = tableauRef(X, 2)
                Cells(Y + 2, 4) = tableauRef(X, 4)
                Exit For
            End If
        Next X
    Next Y
End Sub