Code couleur différente pour les valeur ajoutée

Bonsoir à vous tous,

je voudrais ajouté a mon code vba un commande qui sert a colorer les valeurs ajouté en couleur rouge par exemple.

le code vba:

Sub MettreAjourlisteAr()
    Set fb = Sheets("listeAr")
    Set fp = Sheets("Stock")
    For lnB = 1 To fb.Range("B" & Rows.Count).End(xlUp).Row
        flag = 0
        For lnP = 9 To fp.Range("B" & Rows.Count).End(xlUp).Row
            If fb.Range("B" & lnB) = fp.Range("B" & lnP) Then
                lgn = lnP
                flag = 1
                Exit For
                End If
               Next lnP
               If flag = 0 Then
               lgn = fp.Range("B" & Rows.Count).End(xlUp)(2).Row
        End If
        fb.Range("B" & lnB & ":C" & lnB).Copy
        fp.Range("B" & lgn).PasteSpecial
    Next lnB

Compteur = 1
With ThisWorkbook.Sheets("Stock")
    For i = 10 To .Cells(.Rows.Count, 2).End(xlUp).Row
        If .Cells(i, 2) <> vbNullString Then .Cells(i, 1) = Compteur: Compteur = Compteur + 1
    Next i
End With
With Range("A10:F100000")

        .Font.Bold = True
        .Font.Size = 10
        .Font.Italic = True
        .Font.Name = "Century Gothic"
        '.Font.Color = RGB(0, 0, 0)
     End With

         For Each cellule In Range("A10:L10000")
         If cellule <> "" Then cellule.Borders.Weight = xlThin
         Application.CutCopyMode = False
     Next
         LastRow = ActiveSheet.Range("B10").End(xlDown).Row
         Range("B10:L" & LastRow).Sort Key1:=Range("B10"), Order1:=xlAscending, Key2:=Range("B10"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
         :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
         DataOption2:=xlSortNormal

        Rows("10:1025").EntireRow.AutoFit
       Sheets("Stock").Range("c17:c20").WrapText = True 'Adapter le texte au cellule

MsgBox "...C'est  fini..."
End Sub

Merci pour votre aide.

Je vous joins un fichier exemple.

Avec mes cordiales salutations.

Bonjour,

Postes un fichier exemple afin que nous n'ayons pas à tout construire !

Re-bonjour Theze

Ah !! voila je joint mon exemple

Bonjour,

D'après ce que j'ai compris de ton code, voici une code plus rapide et qui fait ce qui est demandé (enfin je pense !). Il est fortement différent du tien mais les explications sont en commentaires :

Sub MettreAjourlisteAr()

    Dim PlglstAr As Range
    Dim PlgStock As Range
    Dim CelAr As Range
    Dim CelStock As Range

    'défini les plages sur les deux feuilles
    With Worksheets("listeAr"): Set PlglstAr = .Range(.Cells(10, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
    With Worksheets("Stock"): Set PlgStock = .Range(.Cells(10, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With

    'supprime les éventuelles colorations de fonte
    PlgStock.Offset(, -1).Resize(PlgStock.Rows.Count, 3).Font.ColorIndex = 0

    'parcour la plage de la feuille "listeAr"...
    For Each CelAr In PlglstAr

        'et recherche la valeur de la cellule en cours dans la plage de la feuille "Stock"
        Set CelStock = PlgStock.Find(CelAr, , xlValues, xlWhole)

        'si pas trouvée...
        If CelStock Is Nothing Then

            With PlgStock

                'redimensionne la plage pour ajouter à la fin la nouvelle valeur ainsi que celle qui se trouve à coté
                Set PlgStock = .Resize(.Rows.Count + 1, .Columns.Count)
                PlgStock(.Rows.Count, 1).Value = CelAr.Value
                PlgStock(.Rows.Count, 1).Offset(, 1).Value = CelAr.Offset(, 1).Value

                'colore la fonte en rouge des deux cellules
                PlgStock(.Rows.Count, 1).Font.ColorIndex = 3
                PlgStock(.Rows.Count, 1).Offset(, 1).Font.ColorIndex = 3

            End With

        End If

    Next CelAr

    'redéfini la plage pour y incorporer les colonnes A et C
    Set PlgStock = PlgStock.Offset(, -1).Resize(PlgStock.Rows.Count, 3)

    'tri la plage, ce qui a pour effet de déplacer les lignes vides en fin de plage
    PlgStock.Sort PlgStock(1, 2), xlAscending

    'on redéfini la plage pour exclure les lignes vides
    With Worksheets("Stock"): Set PlgStock = .Range(.Cells(10, 1), .Cells(.Rows.Count, 3).End(xlUp)): End With

    'numérote les deux première cellule de la colonne A...
    PlgStock(1, 1).Value = 1
    PlgStock(2, 1).Value = 2

    'puis incrémente de 1
    PlgStock(1, 1).AutoFill Range(PlgStock(1, 1), PlgStock(PlgStock.Rows.Count, 1)), 9

    'aligment des valeurs
    PlgStock.Columns(2).HorizontalAlignment = xlGeneral
    PlgStock.Columns(3).HorizontalAlignment = xlRight

    'paramétrage de la plage
    With PlgStock

        .Font.Bold = True
        .Font.Size = 10
        .Font.Italic = True
        .Font.Name = "Century Gothic"
        .Borders.Weight = xlThin

    End With

    MsgBox "...C'est  fini..."

End Sub

Bonjour le forum

Bonjour Theze

c'est exactement ce que tu pense,

bizarre...votre code vba est très rapide .

merci beaucoup pour votre aide précieuse.

je tiens à vous remercier pour votre aide et votre soutien

cordialement.

Heureux de t'avoir aidé

Merci à celui qui fait un geste,

Merci qui vous tient la porte,

Merci qui vous aide, qui est ... la moindre chose,