Macro pour copier des cellules selon conditions

Bonjour,

J'ai besoin d'aide pour faire une macro.

L'objectif est de reporter les données de la colonne F dans les autres cellules de la colonne pour les lignes ayant le même numéro de pièce (Colonne B)

Merci pour votre aide

Hello,

Voici :

Sub alim_cpt_auxi()

Dim obj_Dico As Object
Dim var_arr_temp As Variant, var_keys As Variant
Dim i As Long

Set obj_Dico = CreateObject("Scripting.Dictionary")
var_arr_temp = Range("B2:B" & [B65000].End(xlUp).Row)
For i = LBound(var_arr_temp) To UBound(var_arr_temp)
    If Not Cells(i + 1, 6) = Empty Then obj_Dico(var_arr_temp(i, 1)) = Cells(i + 1, 6)
Next i
var_arr_temp = [A1].CurrentRegion
For Each var_keys In obj_Dico.keys
    For i = LBound(var_arr_temp) To UBound(var_arr_temp)
        If var_arr_temp(i, 2) = var_keys _
            And var_arr_temp(i, 6) = "" Then
                var_arr_temp(i, 6) = obj_Dico.Item(CStr(var_keys))
        End If
    Next i
Next var_keys
[A1].Resize(UBound(var_arr_temp, 1), UBound(var_arr_temp, 2)) = var_arr_temp
Set obj_Dico = Nothing

End Sub