Sub test()
Sheets("Feuil2").Select
zones = Array(1, 14, 27, 39) 'définition des lignes pour les 4 zones
For N = 0 To UBound(zones)
Call suite(Sheets("Feuil2").Cells(zones(N), 7)) 'pour chaque zone bdd
Next
Sheets("Feuil1").Select
End Sub
Sub suite(z)
N = 0
c = 1
Set debtable = Sheets("Feuil1").Columns(1).Find(z) 'recherche dans la colonne 1 le début du tableau de la zone concernée
While z.Offset(N, 0) <> "" 'Tant que la cellule est différente de ""
z.Select
If z.Offset(N, 0).Interior.ColorIndex = 6 Then ' si sa couleur est jaune
debtable.Offset(3 + c, 4) = z.Offset(N, 0) ' inscription du résultat
c = c + 1 'compteur de résultat par zone
End If
N = N + 1
Wend
End Sub