Option Explicit
Sub copie()
Dim i As Long
Dim k As Long
Dim p As Long
Dim x As Integer
Dim j As Integer
Dim h As Integer
Range("M17:AK17").ClearContents ' suppression du contenu de la colonne M à AK ligne 17
For i = 7 To 65536 ' boucle de la ligne 7 à 65536
If Cells(i, 3) = "" Then Exit For ' si la cellule ligne i de la colonne C est vide alors sortir
For j = 13 To 37 ' boucle de la colonne M à la colonne AK
If Cells(i, 3) = Cells(16, j) And Cells(17, j) = "" Then ' si la cellule ligne i colonne C est égale à la cellule ligne 16 colonne M à AK
' et que la cellule en dessous ligne 17 celle-ci est vide alors
Cells(17, j) = Cells(i, 4) ' la cellule ligne 17 colonne M à AK est égale à la cellule ligne i colonne C
Exit For ' sortie de la boucle
End If ' fin si
Next j ' fin boucle j
Next i ' fin boucle i
For k = 7 To 65536 ' idem que pour i
If Cells(k, 6) = "" Then Exit For ' colonne F concernée
For x = 13 To 37 ' idem que pour j
If Cells(k, 6) = Cells(16, x) And Cells(17, x) = "" Then
Cells(17, x) = Cells(k, 7)
Exit For
End If
Next x
Next k
For p = 7 To 65536 ' idem que pour i
If Cells(p, 9) = "" Then Exit For 'colonne I concernée
For h = 13 To 37 ' idem que pour j
If Cells(p, 9) = Cells(16, h) And Cells(17, h) = "" Then
Cells(17, h) = Cells(p, 10)
Exit For
End If
Next h
Next p
End Sub