1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
| Dim x As Integer, z As Integer, deb() As Integer, fin() As Integer
Dim DerniereLigne As Integer
DerniereLigne = ActiveSheet.Range("D65536").End(xlUp).Row
'*****************************************************************************************************
'alimente les deux tableaux debut et fin des noms à définir
z = 1
ReDim deb(2)
ReDim fin(2)
deb(1) = 3
For x = 3 To DerniereLigne
If Range("a" & x).Interior.ColorIndex = 48 Then ' code couleur
deb(z + 1) = Range("a" & x).Row
fin(z) = Range("a" & x - 1).Row
z = z + 1
ReDim Preserve deb(z + 1)
ReDim Preserve fin(z + 1)
End If
Next x |