recherche position et collage

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