VBA pour rechercher une valeur et mettre en couleur

Re

Voilà

(re)

Je ne trouve pas cela si long...

Par contre j'ai quand même fait cette petite modif qui va de toute façon rendre le traitement plus rapide puisque ces 2 instructions ne servent à rien

    For cptOnglet = 1 To 12

        'Sheets("JAN").Activate
        'Range("C7").Select

Re,

J'avais ajouté ces instructions car lorsqu'elle ne le sont pas, la feuille colorie également des cellules dans la feuille TBL B ...

Sachant que les feuille : "Para", "C ds" et "C ds2" seront masqué.

Sinon que pense tu du tableur ? J'avoue que je me suis pas mal embêter et qu'avec VBA ont peut surement tout faire plus simplement

De plus tout n'est pas finis, rien que pour l'incrémentation dans le calendrier il y a des mois ou il y a N/A mais c'est normal je sais à quoi c'est dût

Par contre je n'ai toujours pas réussis à incrémenter ce code pour qu'il ne prenne en compte que la case vide pas les deux au dessus ni celle en dessous :

 If cel.Text = Sheets("Para").Range("F6") Then
                cel.Interior.ColorIndex = xlColorIndexNone
                'cel.Interior.ColorIndex = sans couleur
End If

Bonjour à tous

@ NCC

Après réflexion je n'ai finalement pas besoin d'ajouter la macro sans couleurs avec l'enregistrement de commande, elle est nécessaire pour une autre opération donc je peux les dissocier

Sinon voila la solution pour que l'opération ne s'effectue que dans les deux pages voulue en fonction du mois de début et de fin de la dernière commande incrémenté directement dans ma macro d'enregistrement :

Sub Enregistrer()

If Sheets("TBL B").Range("Q39").Value = "OK" Then

Dim reponse As Long

reponse = MsgBox("Êtes vous sûr de vouloir enregistrer cette commande ?", _
vbYesNo + vbQuestion + vbDefaultButton, _
"")

If reponse = vbYes Then

'excepter la cellule C14
Sheets("Data").Rows("3:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
LastRow = Sheets("TBL B").Cells(Rows.Count, 3).End(xlUp).Row

For i = 4 To LastRow
 If Sheets("TBL B").Range("C" & i) <> 0 And i <> 14 Then
   n = n + 1
   Sheets("Data").Cells(3, n).Value = Sheets("TBL B").Cells(i, "C").Value
 End If
Next

Sheets("Data").Activate
    Range("M3").Select
    ActiveCell.FormulaR1C1 = "=MONTH(RC[-11])"

    Range("N3").Select
    ActiveCell.FormulaR1C1 = "=MONTH(RC[-11])"

    Range("O3").Select
    ActiveCell.FormulaR1C1 = "=ROW(RC[-1])"

    Sheets("TBL B").Select
    Range("C:C").ClearContents

Call recherche_colori_final

 MsgBox "La commande à bien été prise en compte"

Else
End If

Else

Sheets("TBL B").Select
    Range("C4").Select

MsgBox "Merci de compléter toutes les données obligatoires (*) avant d'enregistrer la commande"

End If
End Sub

Et voici la macro recherche_colori_final :

Sub recherche_colori_final()
Dim cel
Dim celCouleur          ' <= bloc de cellules a colorer
Dim plage1 As Range

Dim tabOnglets(1 To 12)
Dim cptOnglet

    ' ATTENTION la liste ci-dessous doit reprendre EXACTEMENT le nom des onglets !!!
    tabOnglets(1) = "JAN"
    tabOnglets(2) = "FEV"
    tabOnglets(3) = "MAR"
    tabOnglets(4) = "AVR"
    tabOnglets(5) = "MAI"
    tabOnglets(6) = "JUIN"
    tabOnglets(7) = "JUIL"
    tabOnglets(8) = "AOU"
    tabOnglets(9) = "SEP"
    tabOnglets(10) = "OCT"
    tabOnglets(11) = "NOV"
    tabOnglets(12) = "DEC"

Sheets("Data").Activate

    For cptOnglet = Sheets("Data").Range("M3").Value To Sheets("Data").Range("N3").Value

    Sheets(tabOnglets(cptOnglet)).Select

        Set plage1 = Sheets(tabOnglets(cptOnglet)).Range("C7:AG122")

        For Each cel In plage1

               If cel.Text = Sheets("Para").Range("F3") Then
                Range(Cells(cel.Row - 2, cel.Column), Cells(cel.Row + 1, cel.Column)).Interior.ColorIndex = 4
                'cel.Interior.ColorIndex = 4 (vert)

            Else

            If cel.Text = Sheets("Para").Range("F4") Then
                    Range(Cells(cel.Row - 2, cel.Column), Cells(cel.Row + 1, cel.Column)).Interior.ColorIndex = 3
                    'cel.Interior.ColorIndex = 3 (rouge)

                End If
            End If

            Next cel

            Next

End Sub

Je te remercie pour tout NCC

J'ouvre un nouveau sujet pour une nouvelle question non en rapport avec celui ci, ce problème est donc résolut

Bonjour

Koko_Swiff a écrit :

Je te remercie pour tout NCC