Sub RecopiePlage()

bonsoir, peut-être en remplacant

ElseIf [BZ101] = "Ok" Then

par

End if
If [BZ101] = "Ok" Then

Bbonjour
j ai mis le code ainsi dans la feuille le graphe fonctionne en temps réel les OK changent de cellules au bon timing mais le pas des changements ne se répercutent pas sur les 2 graphes ????
peut être faut il linscrire a un autre emplacement????

Option Explicit

Sub Worksheet_SelectionChange(ByVal target As Range)
Dim Lig As Byte, Col As Byte
If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
Range("DP2") = target
End If
End Sub

Private Sub Worksheet_Change(ByVal target As Range)
If Not Application.Intersect(target, Range("AX101,AX144,AX187,AX230,AX273")) Is Nothing Then
If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
ElseIf Not Application.Intersect(target, Range("BZ101,BZ144,BZ187,BZ230,BZ273")) Is Nothing Then
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then

etc......

ce qui fait changer les OK ce sont ces formules ex sur un cote

=SI(BY101>0,0175;"OK";"")
=SI(ET(BY144>0,014;BY144<=0,0175);"OK";"")
=SI(ET(BY187>0,009;BY187<=0,014);"OK";"")
=SI(ET(BY230>0,005;BY230<=0,009);"OK";"")
=SI(ET(BY273>=0;BY273<=0,005);"OK";"")

Chaque BY correspond a un MAX d'une plage

=MAX(BO102:BW141)
=MAX(BO145:BW184)
=MAX(BO188:BW227)
=MAX(BO231:BW270)
=MAX(BO274:BW313) ce qui correspond pour ce cote a 5 barres de progressions comme ceci

0,25% 0,50% 0,75% 1,00% 1,25% 1,50% 1,75% 2,00% >2,00%

0,20% 0,40% 0,60% -0,80% 1,00% 1,20% 1,40% 1,60% >1,60%

0,15% 0,30% 0,45% 0,60% 0,75% 0,90% 1,05% 1,20% >1,20%

0,10% 0,20% 0,30% 0,40% 0,50% 0,60% 0,70% 0,80% >0,80%

0,05% 0,10% 0,15% 0,20% 0,25% 0,30% 0,35% 0,40% >0,40%

le OK change chaque fois que une des cotations dépassent la condition inscrite dans les cellules BY(pour ce cote dans notre exemple)
il y a deux graphes chaque graphe a un cote positif et un cote négatif il y a au total 20 plages qui permettent de rendre les 2 graphes visiblent a l ecran beaucoup plus animés
puisque selon le max il passe de un pas de 0.05% au minimum a la plus grande progression qui est de 0.25% en 0.25% les formules dans les plages sont de ce type
exemple pour la plus petite progression de 0.05en 0.05

0,05% 0,10% 0,15% 0,20% 0,25% 0,30% 0,35% 0,40% >0,40%

=SIERREUR(SI(ET(BC12>=0;BC12<=0,0005);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,0005;BC12<=0,001);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,001;BC12<=0,0015);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,0015;BC12<=0,002);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,002;BC12<=0,0025);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,0025;BC12<=0,003);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,003;BC12<=0,0035);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,0035;BC12<=0,004);BC12;"");"")
=SIERREUR(SI(BC12>0,004;BC12;"");"")
il ya 360 formules de ce type par plage puisque cela correspond aux 40 valeurs du Cac40 soit 360*5*4=7200

j ai mis le code comme ceci dans la feuille a la suite du premier code quand je mets les deux parenthèses après call RecopiePlage elles s'effacent d'elles même j ai aussi le message suivant qui apparaît quand j essaye d'activer le graphe
seuls les commentaires peuvent apparaître après end sub end function ou end property
je ne sais pas si c'est pas mieux de trouver pourquoi ne marche pas le code d'avant parceque la procédure égale est parfaitement respectée, le graphe tourne en temps reel c'est seulement au changement des OK que quelque chose cloche moi je crois que c'est dans l écriture du code parce que le début du code ressemble étrangement a celui qui le précède ;hors celui qui le précède ne fonctionne que si il y a action sur les cellules et dans notre cas on a pas d'action sur les cellules c'est elles qui changent elles même

Private Sub Worksheet_Change(ByVal target As Range)
If Not Application.Intersect(target, Range("AX101,AX144,AX187,AX230,AX273")) Is Nothing Then
et
Sub Worksheet_SelectionChange(ByVal target As Range)
Dim Lig As Byte, Col As Byte
If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
Range("DP2") = target le code de #2 je l ai inscrit ainsi

Option Explicit
Sub Worksheet_SelectionChange(ByVal target As Range)
Dim Lig As Byte, Col As Byte
If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
Range("DP2") = target
End If
End Sub
Option Compare Text

Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True

If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
Call RecopiePlage
End If
End Sub

je viens de mettre le code dans un module a part et la macro s'actionne parfaitement-mais par bouton j ai enlevé call recopieplage() donc c'est qu on est pas du tout loin de la vérité maintenant il faut trouver un moyen que le changement de OK se fasse seul
de plus lorsque j ai essaye il y avait un résultat qui correspondait parfaitement a la réalité 2 plages étaient complètement différente d'un cote et de l autre mais ça reflétait exactement l équivalent de ce que donnait les OK

cela ne servirait a rien puisque le timer est a part de la partie graphique je l ai désolidarise puisque il m empêche de pouvoir travailler sur le fichier
de plus ces deux graphiques ou je veux faire changer le pas de progression me servent uniquement pour modèle afin que le develloper qui me transcrit ma logique sur le web en java script comprenne exactement ce que je fait

Bonjour
toujours pas de solution ?? le graphe a tourne toute la journée la macro marche mais il faut l actionner ne pourrait on pas ecrire un code qui dise que lorsque un OK est dans une des 20 cellules ; alors copier en mode valeur ce OK sur la cellule directement a droite pour le cote positif et directement a gauche pour le cote negatif puis un autre code qui dit des que le contenue d 'une des 20 cellules ou est inscrit OK est egal a ("") ; actionner la macro recopie plage autant de fois qu il y a de changements ..???

les OK actuels du cote positifs sont en BY101; BY144;BY187;BY230;BY273;BY316.BY359;BY402;BY445,

les OK actuels du cote négatif en AX101; AX144;AX187;AX230;AX273;AX316.AX359;AX402;AX445

le timer est étranger complètement a cette procédure puisque on ne s'en sert pas pour ces 2 graphes

il faut dabord comprendre le systeme
a la base ce sont 2 graphiques a barres de progression identique mise a part que un donne les cotations par rapport au début de la séance et l autre par rapport a la veille
au depart j ai choisi par facilite de faire les barres avec un pas de 0.25 en 0.25 c'est a dire que la barre demarre a zero et s'arrete a 2.00% comme ceci
>-2,00% -2,00% -1,75% -1,50% -1,25% -1,00% -0,75% -0,50% -0,25% pour le negatif et
0,25% 0,50% 0,75% 1,00% 1,25% 1,50% 1,75% 2,00% >2,00%pour le positif
j ai par la suite décidé pour que les graphes soient plus animes d"ajouter 5 pas cela démarre en 0.05 puis en 0.10 puis en 0.15 puis en 0.20 et au final j arrive a l ancien graphe 0.25 pour que ce systeme fonctionne j ai créé les plages correspondantes a ces graphes chaque plage a les formules adaptes pour son pas pour que le systeme s actionne j ai sélectionné chaque plage pour avoir le Max qui est évidement le même dans chaque plage c'est le critère qui est inscrit dans la cellule ou viennent se mettre les OK qui font que les plages changent
exemple si je suis dans la plus petite plage qui part de 0 a 0.40%
je dit si le max de cette plage est supérieur ou égal a 0 et inférieur ou égal a 0.50 alors mettez moi OK dans la cellule
pour la deuxième barre je mets comme critère si le max est supérieur a 0.5% et inférieur ou égal a 0.9% alors mettez moi OK dans la cellule
pour la troisiem barre je mets comme critere si le max est supérieur a 0.9% et inferieur ou egal a 1.4% alors mettez moi OK dans la cellule
pour la quatrième barre je mets comme critère si le max est supérieur a1.4% et inférieur ou égal a 1.75% alors mettez moi OK dans la cellule
pour la cinquième barre( la derniere) je mets comme critère si le max est supérieur a 1.75% alors mettez moi OK dans la cellule
pour le négatif c'est la même chose en inversant les signes
Donc c'est bien les OK qui sont chargé de régler les plages a mesure que le max augmente ou diminue
on peut parfois avoir un pas différent sur les 4 plages des 2 graphes selon les cours qui s'affichent ou doivent apparaître sur les 2 graphes principaux i
pour moi du moment que la macro provoque le changement manuellement(si un Ok a change evidement) je pense qu i est tout a fait possible de faire un code

j ai pense a dupliquer les cellules OK en mode valeur a cote pour qu il n y ai aucune formule dans la cellule vu ce que tu m 'as dit hier
je pense que le code peut distinguer une cellule OK et une cellule ou il n y a rien dedans (maintenant je ne sais pas comment s'ecrit en code la détection de changement dans une cellule????

en fait il ne faudrait plus faire référence aux plages simplement dire """chaque fois qu une des cellules passent d' OK a ("") alors actionner la macro recopieplage je ne vois pas d'autres moyens que celui ci cela fait une action pour copier en mode valeur les cellules contenant les OK et un autre code qui actionne ces cellules en mode valeur des que l une d'entre elles change

oui je comprends bien ce que tu veux me dire
alors si au lieu de mettre dans le code la condition OK,on mettait les criteres du MAX des plages qui sont inscrit dans d autres cellules
(puisque eux ils changent )
lorsqu' ils atteindront le critère inscrit dans la formule alors peur être que le changement se fera automatiquement
on dirait pour les plages

BO101:BW141;BO144:BW184;BO187:BW227;BO230:BW270;BO273:BW313

condition1
SI(BY101>0,0175)
condition 2
SI(ET(BY144>0,014;BY144<=0,0175)
Condition3
SI(ET(BY187>0,009;BY187<=0,014)
Condition4
SI(ET(BY230>0,005;BY230<=0,009)
Condition5
SI(ET(BY273>=0;BY273<=0,005)

etc pour les autres plages...

. de quelle maniére inscrire ces formules a la place des OK????

est ce que tu peux me corriger mon code je ne sais pas de quelle façon cela s’écrit?????? (elles se mettent en rouge, je ne dois pas respecterle mode d'ecriture sans doute...)
après j essayerais
les cellules prises en compte ,cette fois ne sont pas inertes elles correspondent au max de chaque plage donné en temps réel

Option Compare Text
Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True

If [AY101] <-0,0175" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AY144] <-0,014 ; [AY144] >=-0,0175 Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AY187] <-0,009 ; [AY187]>=-0,014 Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AY230] <-0,005 ; [AY230] >=-0,009Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AY273] <0 ; [AY273] >)-0,005 Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BY101] >0,0175 Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BY144] >0,014 ; [BY144] <=0,0175 Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BY187] >0,009 ;[BY187]<=0,014 Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BY230] >0,005 ; [BY230]<=0,009Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BY273] >= 0 ; [BY273] <=0,005Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AY316] <=0,0175 Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AY359] <-0,014 ; [AY359] >=-0,0175 Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AY402] <-0,009 ; [AY402] >=-0,014Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AY445] <=0,005 ; [AY445] >=-0,009 Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AY488] <0 ; [AY488] >=-0,005 Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BY316] > 0,0175 Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BY359] >0,014 ; [BY359] <=0,0175 Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BY402] >0,009 ;[BY402] <=0,014 Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BY445] >0,005 ; [BY445] <=0,009 Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BY488] >=0 ; [BY488] ;<=0,005 Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

il y en a un qui m a dit de mettre ca dans la feuille
Private Sub Worksheet_Calculate()
Call RecopiePlage
End Sub et de garder le code recopieplage dans le module

j ai essaye ca marche mais le probleme est que ca tourne en boucle et ca copie sans interruption
alors quil faudrait que ca copie des que un ok a change de cellule et que la copie ne se fasse que une fois
ainsi le pas reste le meme tant que le Ok n a pas change a nouveau de cellule

oui je mets le code que je veux
ca donne le même résultat avec l'ancien et le nouveau c'est exactement pareil je suis oblige d actionner la macro manuellement avec le bouton
si tu dits qu on peut l améliorer c'est daccord mais il faut qu il copie des qu'un des 4 Ok change et qu'il copie une seule fois tant que aucun autre changement n 'est détectée parceque sinon ca va faire comme je t ai dit tourner sans arrêt en boucle et c'est pas bon

pour gagner un peu de temps, nouvelle sub linkrg:

Private Sub linkrg(Target As Range, source As Range)
Application.ScreenUpdating = False
source.Copy
Target.Parent.Activate
Target.Select
Target.Parent.Paste Link:=True
Target.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub 

je propose ceci pour éviter de recopier tout le temps tout, ceci ne devrait plus recopier la première série que quand un "ok" y change. si c'est bon, j'adapte pour les trois séries suivantes:

Sub RecopiePlage()
Static ax1 As Integer

If [AX101] = "Ok" Then
    If ax1 <> 101 Then
        Call linkrg([CK11:CS51], [BA101:BI141])
        ax1 = 101
    End If
ElseIf [AX144] = "Ok" Then
    If ax1 <> 144 Then
        Call linkrg([CK11:CS51], [BA144:BI184])
        ax1 = 144
    End If
ElseIf [AX187] = "Ok" Then
    If ax1 <> 187 Then
        Call linkrg([CK11:CS51], [BA187:BI227])
        ax1 = 187
    End If
ElseIf [AX230] = "Ok" Then
    If ax1 <> 230 Then
        Call linkrg([CK11:CS51], [BA230:BI270])
        ax1 = 230
    End If
ElseIf [AX273] = "Ok" Then
    If ax1 <> 273 Then
        Call linkrg([CK11:CS51], [BA273:BI313])
        ax1 = 273
    End If
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
End Sub

j ai mis le code comme ceci dans le module matin je verrais si ca marche demain matin

Private Sub linkrg(Target As Range, source As Range)
Application.ScreenUpdating = False
source.Copy
Target.Parent.Activate
Target.Select
Target.Parent.Paste Link:=True
Target.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub RecopiePlage()
Static ax1 As Integer

If [AX101] = "Ok" Then
If ax1 <> 101 Then
Call linkrg([CK11:CS51], [BA101:BI141])
ax1 = 101
End If
ElseIf [AX144] = "Ok" Then
If ax1 <> 144 Then
Call linkrg([CK11:CS51], [BA144:BI184])
ax1 = 144
End If
ElseIf [AX187] = "Ok" Then
If ax1 <> 187 Then
Call linkrg([CK11:CS51], [BA187:BI227])
ax1 = 187
End If
ElseIf [AX230] = "Ok" Then
If ax1 <> 230 Then
Call linkrg([CK11:CS51], [BA230:BI270])
ax1 = 230
End If
ElseIf [AX273] = "Ok" Then
If ax1 <> 273 Then
Call linkrg([CK11:CS51], [BA273:BI313])
ax1 = 273
End If
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW402])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW445])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW488])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
End Sub