Copier valeur d'une cellule si sa valeur change

Bonjour à tous,

Je me permets de vous contacter car je suis un peu bloqué...Dans le fichier joint, j'ai créé un code me permettant de détecter le changement de valeur d'une cellule (C2) en fonction d'une autre (D2) et de la copier en B2. Mon problème est le suivant; j'aimerais pouvoir comparer l'évolution de mon encours (C2) par rapport à celui de la veille (B2). Pour cela, lorsque la valeur de la cellule D2 change, j'aimerais copier en valeur l'ancienne valeur de la cellule C2 et la coller dans la cellule B2. Exemple, si aujourd'hui D2 vaut 4, alors C2 vaut 4 et B2 vaut 4. Si demain D2 vaut 5, alors C2 vaut 5 mais je voudrais conserver la valeur 4 en B2... Suis-je assez clair ? Merci de vos retours.

Bonjour,

Un test si j'ai bien compris, à placer dans le code de la Feuil1 et retirer la formule en C2, mettre 4 en B2 et C2 :

Public J_1%, J%
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, [D2]) Is Nothing Then
    If Target.Value = "" Then
        Application.EnableEvents = False
        Target = J
        Application.EnableEvents = True
        Exit Sub
    Else
        [B2] = J_1
        [C2] = J
        J_1 = [C2]
        J = [D2]
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
J_1 = [C2]
J = [D2]
End Sub

A tester tout de même car je ne suis pas sûr d'avoir tester tous les cas.

Cdlt,

Bonjour Ergotamine, merci de votre retour rapide !

Private Sub Worksheet_Change ne fonctionne pas dans mon cas, car le changement de valeur dépend d'une formule dans mon cas, d'où le Private Sub Worksheet_Calculate ...

En fait, ma cellule D7 renvoie vers une référence d'un autre fichier du type ='[Tb Refi.xlsx]Tbord Refi'!$Z$8. Cette référence renvoie un nombre qui change tous les jours et ce nombre correspond à mon encours J (cellule C7). Je voudrais qu'à chaque fois que cette référence change, Excel détecte ce changement et copie/colle en valeur ce nombre en B2 qui correspondra donc à mon encours de la veille (encours J-1). Ainsi la valeur contenue en C2 aujourd'hui deviendra la valeur contenue en B2 et ainsi de suite. Est-ce plus clair ? Merci pour votre aide

Bonjour,

Il faut arrêter les liaisons entre fichier ... De plus, je ne comprend toujours pas ce lien entre C7 et D7, si c'est le même alors autant faire les modifications en commentaires dans le code ci-dessous et ne travailler que sur 2 cellules.

Pourquoi ne pas simplement lancer une macro standard avec un Workbook("classeur").Open et copier coller cette valeur dans votre classeur en ayant auparavant décalé vos cellules. Ca éviterai tout ce casse tête inimaginable :

Sub MAJ()
Dim WB As Workbook, VAL_MAJ%
Set WB = Workbooks.Open("C:\Users\****\Desktop\Tb Refi.xlsx", , True) 'lien à adapter
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z8")) Then VAL_MAJ = WB.Worksheets("Tbord Refi").Range("Z8")
WB.Close
[B2] = [C2]
[C2] = [D2] 'A supprimer
[D2] = VAL_MAJ '[C2] = VAL_MAJ
MsgBox "Mise à jour terminée", vbInformation
End Sub

Cdlt,

Au temps pour moi je ne suis peut être pas clair. Je joins un autre exemple de ce que j'ai pu faire. Dans ce fichier, c'est exactement le code que je veux mais au lieu de devoir changer manuellement la cellule A2, je veux que celle-ci dépende d'une formule. Par exemple, A2 serait le résultat d'une liaison avec un autre fichier, et je voudrais qu'à chaque fois que cette valeur change celle-ci se copie colle en valeur dans la cellule B2. Merci de votre aide

Bonjour,

Relisez mon précédent message. Vous ne pourrez pas travailler en liant des fichiers entre eux sur le long terme en gérant des procédures événementielles, les valeurs vont s'écraser les unes les autres. Vous vous compliquez clairement la vie. Mieux vaut lancer une macro qui ouvre le fichier d'intérêt et copie colle la valeur. Quel est le point de blocage qui vous gêne dans l'exemple donné ?

Cdlt,

Bonjour Ergotamine,

Je viens d'essayer votre méthode, effectivement elle semble plus logique. Le problème c'est que je voudrais justement que la valeur de C2 écrase et remplace celle de B2 au jour le jour pour pouvoir faire un comparatif de la veille entre B2 et C2. Je n'arrive pas à modifier votre code. Pouvez-vous m'éclairer ? Merci bonne journée

Bonjour,

C'est ce que le code fait. Je vous mets les commentaire pour que vous compreniez mieux :

Sub MAJ()
Dim WB As Workbook, VAL_MAJ%
Set WB = Workbooks.Open("C:\Users\****\Desktop\Tb Refi.xlsx", , True) 'lien à adapter
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z8")) Then VAL_MAJ = WB.Worksheets("Tbord Refi").Range("Z8") 'Enregistre la valeur de Z8 dans la variable VAL_MAJ si elle n'est pas vide
WB.Close 'Ferme le classeur Tb Refi
[B2] = [C2] 'Colle la valeur de C2 dans B2
[C2] = [D2] 'A supprimer
[D2] = VAL_MAJ '[C2] = VAL_MAJ 'Colle la valeur contenue dans VAL_MAJ dans D2 (ou C2 si remplace [D2] par [C2]
MsgBox "Mise à jour terminée", vbInformation
End Sub

Vous pouvez soit mettre cette macro en activation via un bouton, ce que je conseille, soit dans une procédure événementielle, ce que je ne conseille pas car vous n'aurez plus la main sur les updates.

Suite à ces commentaires que vous manque-t-il ? Quel est le point de blocage ? Car lors de l'action du code, la valeur de B2 est bien écrasée par C2 puis C2 devient Z8, donc le comparatif existe bel et bien.

Cdlt,

Merci pour vos précisions Ergotamine. Effectivement je me suis compliqué la tâche pour pas grand chose je pense. Je touche presque au but grâce à vous. Finalement, le plus simple serait d'extraire la valeur contenue dans le ficher Tb Refi en Z8, la copier en C2, le lendemain même chose avec en plus copier l'ancienne valeur de C2 dans B2 et ainsi de suite. Est-il possible de faire tout cela sans ouvrir le classeur Tb Refi ?

Quand je veux dire sans ouvrir le classeur Tb Refi j'entends que celui-ci n'apparaisse pas sur mon écran ?

Bonjour,

Sans l'ouvrir à proprement parler non.

Même si des classeurs sont liés ils sont tout de même "ouverts" pour mettre à jour des liaisons. D'où par exemple lorsque l'on met à jour une valeur, l'autre fichier n'est ouvrable qu'en lecture seul par d'autre utilisateur. C'est pour cela que je déconseille les liaisons entre classeur. Cependant vous pouvez ne pas afficher l’exécution du code par le morceau de code Application.ScreenUpdating = False ce qui a pour effet de ne pas actualiser l'écran pendant l’exécution du code :

Sub MAJ()
Dim WB As Workbook, VAL_MAJ%
Application.ScreenUpdating = False
Set WB = Workbooks.Open("C:\Users\****\Desktop\Tb Refi.xlsx", , True) 'lien à adapter
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z8")) Then VAL_MAJ = WB.Worksheets("Tbord Refi").Range("Z8") 'Enregistre la valeur de Z8 dans la variable VAL_MAJ si elle n'est pas vide
WB.Close 'Ferme le classeur Tb Refi
[B2] = [C2] 'Colle la valeur de C2 dans B2
[C2] = [D2] 'A supprimer
[D2] = VAL_MAJ '[C2] = VAL_MAJ 'Colle la valeur contenue dans VAL_MAJ dans D2 (ou C2 si remplace [D2] par [C2]
MsgBox "Mise à jour terminée", vbInformation
Application.ScreenUpdating = True
End Sub

Cdlt,

Je n'ai plus besoin de liaison entre classeur avec votre solution, j'ai enlevé aussi la message box et supprimé D2=C2 dans le code. Le résultat est exactement ce que je veux, c'est juste assez contraignant d'avoir le classeur Tb Refi qui s'ouvre, qui me demande si je veux mettre à jour les liaisons et qui me demande si je souhaite enregistrer les modifs ...est-il possible de supprimer tout cela sachant que je n'ai plus de référence dans mon classeur copier/collervba ? Je vous joins mes modifications. Encore merci de votre aide.

Bonjour,

Dans ce cas spécifiez la méthode de mise à jour des liens externes dans la procédure workbooks.open. 1 pour mettre à jour, 0 pour ne pas mettre à jour. Dans l'exemple ci-dessous je l'ai mise à 0 pour ne pas avoir d'éventuels effets de bord :

Sub MAJEncours()
Dim WB As Workbook, VAL_MAJ%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set WB = Workbooks.Open("\\Uf11-002\liquidite_cm5cic\1- Fonctionnement\01 Avancé\Portail Liq\Analyse liquidité\jour\Tb Refi.xlsx", 0, True) 'lien à adapter
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z8")) Then VAL_MAJ = WB.Worksheets("Tbord Refi").Range("Z8") 'Enregistre la valeur de Z8 dans la variable VAL_MAJ si elle n'est pas vide
WB.Close False 'Ferme le classeur Tb Refi
[B2] = [C2] 'Colle la valeur de C2 dans B2
[C2] = VAL_MAJ '[C2] = VAL_MAJ 'Colle la valeur contenue dans VAL_MAJ dans D2 (ou C2 si remplace [D2] par [C2]
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Cdlt,

Merci c'est parfait ! Sujet clos ! Bonne journée à vous et merci aux aidants de ce forum !

Je me suis emballé un peu trop vite Ergotamine, je voudrais répéter la même opération pour plusieurs lignes j'ai donc mis à jour la macro mais elle prend un temps infiniment long pour s'achever, je pense que mon code est perfectible ... Une dernière aide ?

Sub MAJ()

Dim WB As Workbook, VAL_MAJ%

Set WB = Workbooks.Open(" 'lien à adapter
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z8")) Then VAL_MAJ1 = WB.Worksheets("Tbord Refi").Range("Z8")
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z9")) Then VAL_MAJ2 = WB.Worksheets("Tbord Refi").Range("Z9")
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z10")) Then VAL_MAJ3 = WB.Worksheets("Tbord Refi").Range("Z10")
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z11")) Then VAL_MAJ4 = WB.Worksheets("Tbord Refi").Range("Z11")
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z12")) Then VAL_MAJ5 = WB.Worksheets("Tbord Refi").Range("Z12")
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z13")) Then VAL_MAJ6 = WB.Worksheets("Tbord Refi").Range("Z13")
If Not IsEmpty(WB.Worksheets("Tbord Refi").Range("Z14")) Then VAL_MAJ7 = WB.Worksheets("Tbord Refi").Range("Z14")

WB.Close False 'Ferme le classeur Tb Refi

[C16] = [D16]
[D16] = VAL_MAJ1
[C17] = [D17]
[D17] = VAL_MAJ2
[C18] = [D18]
[D18] = VAL_MAJ3
[C19] = [D19]
[D19] = VAL_MAJ4
[C20] = [D20]
[D20] = VAL_MAJ5
[C21] = [D21]
[D21] = VAL_MAJ6
[C22] = [D22]
[D22] = VAL_MAJ7

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Bonjour,

Avez-vous un intérêt à tester si les valeurs sont vides ? Pourquoi ne pas copier/coller toute la plage d'un coup en utilisant la propriété skipblanks de la méthode paste ?

De plus, désactivez le calcul automatique via Application.Calculation = xlCalculationManual puis la repasser Application.Calculation = xlCalculationAutomatic en fin de macro.

Cdlt,

Non effectivement, aucun intérêt à tester si les cellules sont vides ...Je ne connais pas la méthode skipblanks une aide pour améliorer cette macro ? Merci pour l'information avec le calcul automatique, je le mets donc après Sub et avant End sub ?

Bonjour,

Dans la logique suivant votre exemple et les derniers éléments à disposition je dirais :

Sub MAJEncours()
Dim WB As Workbook
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
[C16:C22] = [D16:D22] 'Copie de la plage D16:D22 dans la plage C16:C22
Set WB = Workbooks.Open("\\Uf11-002\liquidite_cm5cic\1- Fonctionnement\01 Avancé\Portail Liq\Analyse liquidité\jour\Tb Refi.xlsx", 0, True)
WB.Worksheets("Tbord Refi").Range("Z8:Z14").Copy 'Copie de la plage Z8:Z14
WB.Close False 'Ferme classeur
[D16].PasteSpecial xlPasteValues, , True 'Colle en valeur le contenu du presse papier en D16, True pour ne pas écraser valeur par cellules vides
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Code non testé donc je vous laisse faire le test.

Cdlt,

J'ai un problème avec le coller... j'ai un message d'erreur "la méthode PasteSpecial de la classe Range a échoué" sur la ligne de code suivante;

[D16].PasteSpecial xlPasteValues, , True 'Colle en valeur le contenu du presse papier en D16, True pour ne pas écraser valeur par cellules vides

J'ai refit quelques tests, je suis toujours bloqué avec ce message d'erreur ...un coup de main ? Merci