Bonjour,
Il serait plus judicieux que tous les tableaux soient des tableaux structurés.
Option Compare Text
Sub InsertCode()
Dim Ext As Worksheet: Set Ext = Worksheets("Extraction")
Dim Bdd As Worksheet: Set Bdd = Worksheets("donnée d'entrée")
Dim Bdd_L, J, K As Integer
Dim Ext_D As Range: Set Ext_D = Ext.Cells.Find("code PSA", lookat:=xlPart).Offset(1) ' première cellule de la table extraction
Dim Ext_F As Range: Set Ext_F = Ext.Cells(Ext.Rows.Count, "D").End(xlUp) ' dernière cellule de la table extraction
Dim Bdd_D As Range: Set Bdd_D = Bdd.Cells.Find("code PSA", lookat:=xlPart).Offset(1) ' première cellule de la table Bdd
Dim Bdd_F As Range:
Dim Cols As Integer: Cols = 9 ' Nombre de colonnes à copier
Dim TabEntree As ListObject
Dim LigneEntree As ListRow
Set TabEntree = Bdd.ListObjects("Tableau3")
For J = Ext_D.Row To Ext_F.Row
If Ext.Rows(J).Columns("K") = "Oui" Then
Set LigneEntree = TabEntree.ListRows.Add
With LigneEntree
.Range.Font.ColorIndex = xlAutomatic
.Range.Interior.Pattern = xlNone
For K = 2 To 11
.Range(1, K - 1) = Ext.Cells(J, K)
Next K
End With
Set LigneEntree = Nothing
End If
Next J
Set TabEntree = Nothing
Set Ext_D = Nothing: Set Ext_F = Nothing: Set Bdd_D = Nothing
End Sub