Besoin d'aide, macro balayage colonne + ajout de couleur

[Vich]

Salut tout le monde,

'Saute une ligne à chaque référence différente.
    Dim NbCells As Integer
    NbCells = Range("A1").End(xlDown).Row
    Application.ScreenUpdating = False
    Dim Boucle As Long
    Dim NbLigneSautee As Integer
    NbLigneSautee = 0
    For Boucle = Range("J65536").End(xlUp).Row To 3 Step -1
        If Range("I" & Boucle) <> Range("I" & Boucle - 1) Then
            Range("I" & Boucle).EntireRow.Insert
            NbLigneSautee = NbLigneSautee + 1
        End If
    Next Boucle
    Application.ScreenUpdating = False
    
    'Application de couleur / ref connecteur
    'Tableau avec les différentes valeur des couleurs index pour colorer les lignes
    Dim TableauCouleur(10) As Integer
    TableauCouleur(1) = 15
    TableauCouleur(2) = 23
    TableauCouleur(3) = 43
    TableauCouleur(4) = 3
    TableauCouleur(5) = 44
    TableauCouleur(6) = 23
    TableauCouleur(7) = 38
    TableauCouleur(8) = 45
    TableauCouleur(9) = 48
    TableauCouleur(10) = 41
    Dim B As Long
    Dim C As Integer
    C = 1
    For B = 2 To Range("A65536").End(xlUp).Row
        If Range("A" & B).Value <> "" Then
            Range("A" & B).CurrentRegion.Resize(, 19).Interior.ColorIndex = TableauCouleur(C)
            C = C + 1
        End If
    Next B

Vous l'aurez compris, une macro très simple qui balaye la colonne A et si il y a un saut de ligne il la colore en une certaine couleur définie dans un tableau.

Le problème est qu'il ne me met pas les couleurs dans l'ordre demandé, il en saute plein et arrive vite à la fin du tableau du coup j'ai des lignes blanches.

Je ne comprend pas pourquoi ça ne marche pas, bref need help.

Merci d'avance, Vich.

 

[pierrejean]

Re : Besoin d'aide, macro balayage colonne + ajout de couleur

Bonjour Vich

A tester:

Sub test()
    Dim TableauCouleur(10) As Integer
    TableauCouleur(1) = 15
    TableauCouleur(2) = 23
    TableauCouleur(3) = 43
    TableauCouleur(4) = 3
    TableauCouleur(5) = 44
    TableauCouleur(6) = 23
    TableauCouleur(7) = 38
    TableauCouleur(8) = 45
    TableauCouleur(9) = 48
    TableauCouleur(10) = 41
    num = 1
     For boucle = Range("J65536").End(xlUp).Row To 3 Step -1
        If Range("I" & boucle) <> Range("I" & boucle - 1) Then
            Range("I" & boucle).EntireRow.Insert
            Range("A" & boucle & ":S" & boucle).Interior.ColorIndex = TableauCouleur(num)
            num = num + 1
            NbLigneSautee = NbLigneSautee + 1
        End If
    Next boucle
   End Sub