XL 2010 Transfert de cellule sous condition.( résolu )

Sub copie_New()

Dim tab1() As Variant

With Sheets("Feuil1")
    fin = .Range("E" & .Rows.Count).End(xlUp).Row
    tab1 = .Range("E2:G" & fin).Value
End With

With Sheets("feuil2")
    For i = LBound(tab1, 1) To UBound(tab1, 1)
        Set DejaLa = .Columns(1).Find(tab1(i, 2))
        If DejaLa Is Nothing Then
            If tab1(i, 1) = "A" Or tab1(i, 1) = "D" Then
                .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = tab1(i, 2)
                .Range("A" & .Rows.Count).End(xlUp).Offset(0, 1) = tab1(i, 1)
                .Range("A" & .Rows.Count).End(xlUp).Offset(0, 2) = tab1(i, 3)
                .Range("A" & .Rows.Count).End(xlUp).Offset(0, 5) = "New"
            End If
        End If
    Next i
End With
End Sub

Sub copie_New()
Application.ScreenUpdating = False
Dim tab1() As Variant

With Sheets("Feuil1")
    fin = .Range("E" & .Rows.Count).End(xlUp).Row
    tab1 = .Range("E2:G" & fin).Value
End With

With Sheets("feuil2")
    For i = LBound(tab1, 1) To UBound(tab1, 1)
        Set DejaLa = .Columns(1).Find(tab1(i, 2))
        If DejaLa Is Nothing Then
            If tab1(i, 1) = "A" Or tab1(i, 1) = "D" Then
                .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = tab1(i, 2)
                .Range("A" & .Rows.Count).End(xlUp).Offset(0, 1) = tab1(i, 1)
                .Range("A" & .Rows.Count).End(xlUp).Offset(0, 2) = tab1(i, 3)
                .Range("A" & .Rows.Count).End(xlUp).Offset(0, 5) = "New"
            End If
        End If
    Next i
End With
Application.ScreenUpdating = True
End Sub

Sub copie_New2()
Application.ScreenUpdating = False

Dim tab1() As Variant
Dim tab2() As Variant
Set dico2 = CreateObject("scripting.dictionary")

With Sheets("Feuil1") 'dans la feuille 1
    fin = .Range("E" & .Rows.Count).End(xlUp).Row 'dernière ligne sur la colonne E
    tab1 = .Range("E2:G" & fin).Value 'colonnes EFG dans un tablo vba
End With

With Sheets("feuil2") 'dans la feuille 2
    FinFeuille2 = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne sur la colonne A
    tab2 = .Range("A2:C" & FinFeuille2).Value 'colonnes ABC dans un tablo vba
       
    For i = LBound(tab2, 1) To UBound(tab2, 1) 'pour chaque ligne du tablo2 (feuille2)
        dico2.Item(tab2(i, 1)) = Array(tab2(i, 2), tab2(i, 3), "") 'on crée une clé (Colonne A) avec pour valeur un array composé de Colonne B, colonneC et colonne vide
    Next i
   
    For i = LBound(tab1, 1) To UBound(tab1, 1) 'pour chaque élément du tablo1 (feuille1)
        If Not dico2.exists(tab1(i, 2)) Then 'si la description n'est pas dans le dictionnaire
            If tab1(i, 1) = "A" Or tab1(i, 1) = "D" Then 'si c'est A ou D
                dico2.Add tab1(i, 2), Array(tab1(i, 1), tab1(i, 3), "NEW")
            End If
        End If
    Next i
       
.Range("A2").Resize(dico2.Count) = Application.Transpose(dico2.keys)
tabclé = dico2.items
.Range("B2").Resize(UBound(tabclé, 1) + 1) = Application.Index(tabclé, , 1)
.Range("C2").Resize(UBound(tabclé, 1) + 1) = Application.Index(tabclé, , 2)
.Range("F2").Resize(UBound(tabclé, 1) + 1) = Application.Index(tabclé, , 3)

End With
Application.ScreenUpdating = True
End Sub