macro recherche information dans autre classeur et la colle

Sub Démo_test_comparaison_BDD()

Application.ScreenUpdating = False

'Macro recherche de correspondances dans la BDD

Dim Kol As New Collection
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim c As Range

'mémoriser tous les ID de la feuille de travail à compléter
With Sheets("A compléter")
.AutoFilterMode = False
LastLig2 = .Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To LastLig2
On Error Resume Next
Kol.Add .Range("A" & i).Value, .Range("A" & i).Value
On Error GoTo 0
Next i

'recherche de l'élément dans la feuille BDD
For i = 1 To Kol.Count
With Sheets("BDD")
.AutoFilterMode = False
LastLig1 = .Cells(Rows.Count, 1).End(xlUp).Row
End With
.Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)
Set c = Sheets("BDD").Range("A1:A" & LastLig1).Find(Kol(i), lookat:=xlWhole)

'dans le cas ou l'id existe dans la BDD, le colorier en vert et le copier dans la feuille de calcul

'...comment faire insérer toutes ces lignes non pas à la fin du code mais juste en dessus de l'identifiant en question ?
If Not c Is Nothing Then
Sheets("BDD").Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)

.Range("A2:L" & LastLig2).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
.Range("A2:L" & LastLig2).SpecialCells(xlCellTypeVisible).Copy Sheets("A compléter").Range("B" & LastLig1 + 1)
Set c = Nothing

'dans le cas ou il n'existe pas, mettre la la cellule de l'id en rouge dans le formulaire
Else
.Range("A2").SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 3
End If
Next i
.AutoFilterMode = False
End With
Sheets("BDD").AutoFilterMode = False

End Sub

Cliquez pour agrandir...