Macro pour recopier une formule dans une cellule

Bonjour,


J'ai un tableau Excel qui récupère des données d'une Base Agents en fonction du nom de l'agent (menu déroulant).

J'ai aussi des cellules dans lesquelles la valeur peut être calculée automatiquement ou non, en fonction des critères.

Le problème est que si l'utilisateur est amené à entrer manuellement une valeur, la formule contenue dans la cellule est écrasée.

J'ai déjà une macro qui efface le contenu de certaines cellules quand le nom de l'agent change.
Je cherche à compléter cette macro pour que, dans les cases où la saisie est manuelle ou automatique, la formule contenue dans la cellule soit recopiée à chaque fois que le nom de l'agent est modifié.

En résumé, ça donne ceci :
Si la valeur de B5 change, cela efface B11, B24, B28 ...

Parallèlement, je souhaiterais que la formule contenue en B28 (pour l'exemple, je l'ai simplifiée, mais en fait elle fait plus de 10 lignes) soit recopiée en B28. Je pense qu'il faut déjà inclure la formule dans la macro ; car, comme je l'ai dit, si l'utilisateur tape une valeur lui-même en B28 et que la macro recopie B28, cela ne sert à rien.

J'ai essayé plusieurs codes, repris dans le fichier VB, mais cela ne fonctionne pas.
Si quelqu'un pouvait donc m'aider.

Merci d'avance.

Cordialement.

Bonjour,

Pourquoi dans l'exemple effacer B28 pour la recopier ensuite ?

De plus, ne serait-il pas plus simple d'interdire la saisie manuelle en protégeant la cellule contenant la formule.

Sinon si tu tiens vraiment à recopier alors utilise formula = " =(formule)
Pour mémoire, tu peux utiliser l'enregistreur de macro qui te fabriquera la formule.
pour cela, tu te positionnes sur la cellule qui doit recevoir la formule et tu frappe toutes les éléments entrant dans cette dernière.

Cordialement.

Bonjour le forum,

Merci à Nibledispo pour ta réponse.

Le problème est que je ne peux pas interdire la saisie manuelle puisqu'elle est justement possible alternativement avec l'utilisation de la formule.

Pour l'enregistrement de la macro, j'ai bien essayé, mais ça ne fonctionne pas !

Si quelqu'un a une autre idée ...


Merci d'avance.

Cordialement.

Bonjour,

Quelle est la formule d'une dizaine de lignes car dans la case B28 il n'y présentement que AA.

De plus? tu évoque un fichier VB et tu joins Test1. n'as tu pas oublié de joindre quelque chose ?

En effet, je ne vois dans test1 aucun endroit contenant les retenues habituelles sur un salaire (retraite, maladie, .......).

Cordialement,

Rebonjour,

Le fichier que j'ai envoyé est un fichier de test. Il ne reprend donc pas la plupart des formules que j'ai écrites, ni les retenues sur salaire.

En revanche, dans mon vrai fichier, tout est bien présent. Mais, celui-ci est trop lourd et prendrait beaucoup trop de temps à anonymiser, d'où le fichier test, certes réduit, mais qui reprend l'essentiel.

Je ne peux pas joindre le fichier contenant la macro, puisqu'apparemment le forum n'accepte pas les fichiers .xlsm.

Le voici cependant :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

Private Sub Worksheet_Change(ByVal Target As Range) Dim I As Integer     If Target.Count > 1 Then Exit Sub If Not Intersect(Range("b5"), Target) Is Nothing Then Application.EnableEvents = False   Range("b11").ClearContents Range("b24").ClearContents Range("b28").ClearContents Range("b29").ClearContents Range("c29").ClearContents Range("b30").ClearContents Range("c30").ClearContents ' [...] Application.EnableEvents = True End If   If Target.Address = "$B$28" Then Copy.Range("$B$28").FormulaLocal = "XXXXXX" 'Ici on recopie la formule   End If   End Sub

---

Or, si les cellules s'effacent bien quand la valeur entrée en B5 varie, la valeur de la cellule B28 ne se recopie pas !

Merci d'avance.

Cordialement.

Bonsoir,

Surement comme ça :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

If Target.Count > 1 Then Exit Sub If Not Intersect(Range("b5"), Target) Is Nothing Then '------------------------------------- 'Au passage j'aurai utilisé : 'if target.Address = "$B$5" then ' Ce qui revient au même... '---------------------------------------- Application.EnableEvents = False Range("b11").ClearContents Range("b24").ClearContents Range("b28").ClearContents Range("b29").ClearContents Range("c29").ClearContents Range("b30").ClearContents Range("c30").ClearContents ' [...]   'Recopie de la formule dans B28 Range("B28").Formula = "=IF(""A1""<>2,""ok"",""ko"")" Application.EnableEvents = True End If

---

Quoi qu'il en soit, votre ligne :

Code:

---

1 2	Copy.Range("$B$28").FormulaLocal = "XXXXXX" 'Ici on recopie la formule

---

Doit vous faire une erreur...

Copy.range ? ça n'existe pas il me semble...
A la rigueur :

Code:

---

Range("$B$28").FormulaLocal = "XXXXXX" 'Ici on recopie la formule

---

Pensez également à placer vos Application.EnableEvents = False dès le début du code et le Application.EnableEvents = True juste avant le End Sub..
Sinon, votre programme va boucler sans fin, vu qu'il se déclenche à la modification de la feuille..et que vous modifiez la feuille justement;.

Bonsoir Jordane45,

Merci beaucoup pour le coup de main.

Malheureusement, quand j'exécute la macro, Excel plante.

Il me renvoie des erreurs diverses : "espace pile insuffisant" ou, plus souvent "la méthode formula de l'objet Range a échoué".

Avez-vous une idée ?

Merci d'avance.

Re-,

Autre problème : je n'arrive pas à substituer ma formule Excel à votre exemple dans

Code:

---

Range("B28").Formula = "=IF(""A1""<>2,""ok"",""ko"")"

---

Ma formule est très très longue ! La voici ci-dessous (anonymisée, car à la place des AAA..., il y a des informations) :

Code:

---

=IF(B29="",,IF(OR(B29="AAA",B29="AAB",B29="AAC",B29="AAD"),('BS POUR CONTROLE'!G69+'BS POUR CONTROLE'!G75+'BS POUR CONTROLE'!G80)*$H$48,IF(B29="AAE",1/30*('BS POUR CONTROLE'!G69+IF(OR(B31="Prime1",B31="Prime2",B31="Prime3"),C31)+IF(OR(B32="Prime1",B32="Prime2",B32="Prime3"),C32)+IF(OR(D30="Prime1",D30="Prime2",D30="Prime2"),E30)+IF(OR(D31="Prime1",D31="Prime2",D31="Prime3 "),E31)),IF(B29="AAF",1/50*('BS POUR CONTROLE'!G69+IF(OR(B31="Prime1",B31="Prime2",B31="Prime3"),C31)+IF(OR(B32="Prime1",B32="Prime2",B32="Prime3"),C32)+IF(OR(D30="Prime1",D30="Prime2",D30="Prime2"),E30)+IF(OR(D31="Prime1",D31="Prime2",D31="Prime3 "),E31)),IF(B29="AAG",1/160*('BS POUR CONTROLE'!G69+ IF(OR(B32="Prime1",B32="Prime2",B32="Prime3"),C32)+IF(OR(D30="Prime1",D30="Prime2",D30="Prime2"),E30)+IF(OR(D31="Prime1",D31="Prime2",D31="Prime3 "),E31)),IF(OR(B29="AAH",B29="AAI",B29="AAJ",B29="AAK",B29="AAL",B29="AAM"),0*$H$48,IF(OR(B29="AAN",B29="AAO",B29="AAN",B29="AAQ"),('BS POUR CONTROLE'!G69/2)*$H$48)))))))

---

La formule est pourtant bien au format VBA. Mais impossible de l'insérer : quand j'essaie de la mettre entre les guillemets de formula, elle devient rouge et pas moyen !

Là encore, je suis preneur de toute suggestion !

Merdci d'avance.

Cordialement.

Bonjour,

Dans ta formule, tu dois doubler les apostrophes lorsqu'il y en a.

Donc,

Code:

---

=IF(B29="",,IF(OR(B29="AAA",B29="AAB",

---

devient

Code:

---

=IF(B29="""",,IF(OR(B29=""AAA"",B29=""AAB"",

---

si, bien sûr, AAA est du texte normalement entouré d'apostrophe

Bonjour le forum,

Merci pour ton conseil, Parmi.

Effectivement, en rajoutant les doubles guillemets, ça va déjà mieux.

Cependant, j'ai un autre problème : la formule faisant plusieurs lignes, la macro "vire au rouge" dès que j'atteins la fin de la première ligne. Comment puis-je faire ?

Sans doute avec un & vbcr, mais je ne sais pas exactement comment procéder.

Merci d'avance.

Cordialement.

Je pense avoir trouvé pour aller à la ligne :

Quand je tape :

Code:

---

[fin du code]" & vbCr & ""

---

Je n'ai plus d'erreur.

En revanche, comment fait-on pour entamer la ligne suivante ?

Rebonjour,

Sur ce post http://www.developpez.net/forums/d10...ormule-resolu/, j'ai trouvé une solution :

En indiquant :

Code:

---

1 2 3 4

Dim Frm As String '[...] Frm = "[Mon Code]" Frm = Frm & "[Suite de mon Code]"

---

Cela fonctionne.

En revanche, quand je lui mets, comme dans le post cité ci-dessus :

Code:

---

Range("B28").Formula = Frm

---

j'obtiens une erreur d'exécution 1004.

Quelqu'un pourrait-il m'expliquer ?

Merci d'avance.

Ça dépend possiblement de la façon dont tu "remplis" Frm
Il faudrait voir cette partie pour pouvoir répondre

Bonsoir Parmi,
Bonsoir le forum,

Voici le code en question :

Code:

---

1 2 3

Frm = "=IF(B29="""",,IF(OR(B29=""AAA"",B29=""AAB"",B29=""AAC"",B29=""AAD""),('BS POUR CONTROLE'!G69+'BS POUR CONTROLE'!G75+'BS POUR CONTROLE'!G80)*$H$48,IF(B29=""AAE"",1/30*('BS POUR CONTROLE'!G69+IF(OR(B31=""Prime1"",B31=""Prime2"",B31=""Prime3""),C31)+IF(OR(B32=""Prime1"",B32=""Prime2"",B32=""Prime3""),C32)+IF(OR(D30=""Prime1"",D30=""Prime2"",D30=""Prime3""),E30)+IF(OR(D31=""Prime1"",D31=""Prime2"",D31=""Prime3""),E31)),IF(B29=""AAF"",1/160*('BS POUR CONTROLE'!G69+IF(OR(B31=""Prime1"",B31=""Prime2"",B31=""Prime3""),C31)" Frm = Frm & "+IF(OR(B32=""Prime1"",B32=""Prime2"",B32=""Prime3""),C32)+IF(OR(D30=""Prime1"",D30=""Prime2"",D30=""Prime3""),E30)+IF(OR(D31=""Prime1"",D31=""Prime2"",D31=""Prime3""),E31)),IF(OR(B29=""AAG"",B29=""AAH"",B29=""AAI"",B29=""AAJ"",B29=""AAK"",B29=""AAL""),0*$H$48,IF(OR(B29=""AAM"",B29=""AAN"",B29=""AA0"",B29=""AAP""),('BS POUR CONTROLE'!G69/2)*$H$48)))))))" Range("$C$29").Formula = Frm

---

Je l'ai anonymisé, comme hier.

Je précise que la formule fonctionne très bien sous Excel.

Le problème est donc, à mon avis, une question de syntaxe VBA. En effet, la formule elle-même, copiée en VBA, ne fait pas apparaître d'erreur.
Apparemment, le Frm est également reconnu, puisque quand je passe sur le code, il me met bien à quoi correspond ce Frm.

Merci de ton aide. Là, je patauge complètement.

Tu n'étais pas loin...
Une parenthèse de trop à la fin :ccool:

Bonjour Parmi,
Bonjour le forum,

Malheureusement, ça ne marche pas !

J'ai retourné le problème dans tous les sens depuis hier et rien !

Je pense donc avoir trouvé une solution de contournement. Au lieu de faire une macro pour copier la formule, je peux aller la mettre dans une autre feuille et la copier dans ma case.
J'ai utilisé l'enregistreur de macro et la recopie se fait bien.

En revanche, quand je copie mon code de recopie en dessous du code préexistant (d'effacement des données), ça bug : j'ai toujours le message "la méthode Select de la classe Range a échoué" au niveau de Range("A33").Select. Je précise aussi que la phase d'effacement des données (première partie de la macro) et d'alimentation automatique de B31 en fonction de B15 marche très bien.

Voici mon code. Quelqu'un pourrait-il y regarder ? Je ne suis pas du tout spécialiste des macros et je ne vois vraiment pas que faire !

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152

Private Sub Worksheet_Change(ByVal Target As Range) Dim I As Integer Dim Frm As String   If Target.Address = "$B$6" Then Application.EnableEvents = False Range("b12").ClearContents Range("b25").ClearContents Range("b29").ClearContents Range("c29").ClearContents Range("b31").ClearContents Range("b31").ClearContents Range("b32").ClearContents Range("c32").ClearContents Range("d29").ClearContents Range("d31").ClearContents Range("e31").ClearContents Range("b34").ClearContents Range("c34").ClearContents Range("d34").ClearContents Range("e34").ClearContents Range("b35").ClearContents Range("c35").ClearContents Range("d35").ClearContents Range("e35").ClearContents Range("b36").ClearContents Range("c36").ClearContents Range("d36").ClearContents Range("e36").ClearContents Range("C45").ClearContents Range("C46").ClearContents Range("C47").ClearContents Range("C48").ClearContents Range("E45").ClearContents Range("E46").ClearContents Range("E47").ClearContents Range("E48").ClearContents Range("C50").ClearContents Range("C51").ClearContents Range("C52").ClearContents Range("C53").ClearContents Range("E50").ClearContents Range("E51").ClearContents Range("E52").ClearContents Range("E53").ClearContents Range("C55").ClearContents Range("C56").ClearContents Range("C57").ClearContents Range("C58").ClearContents Range("E55").ClearContents Range("E56").ClearContents Range("E57").ClearContents Range("E58").ClearContents Range("C60").ClearContents Range("C61").ClearContents Range("C62").ClearContents Range("C63").ClearContents Range("E60").ClearContents Range("E61").ClearContents Range("E62").ClearContents Range("E63").ClearContents Application.EnableEvents = True End If     If Target.Address = "$B$6" And Target.Count = 1 And [B15] = "OPERATEUR" Then [B31] = "Prime1" End If If Target.Address = "$B$6" And Target.Count = 1 And [B6] = "ZEZE ROBERT" Then [B31] = "Prime1" End If If Target.Address = "$B$6" And Target.Count = 1 And [B15] = "SECRETAIRE" Then [B31] = "Prime2" End If If Target.Address = "$B$6" And Target.Count = 1 And [B15] = "CADRE" Then [B31] = "Prime3" End If If Target.Address = "$B$6" And Target.Count = 1 And [B15] = "COMPTABLE" Then [B31] = "Prime4" End If   If Target.Address = "$B$6" Then   Sheets("Autres données").Select Range("A33").Select Selection.Copy Sheets("Infos à renseigner").Select Range("C29").Select ActiveSheet.Paste Application.CutCopyMode = False With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent6 .TintAndShade = 0.399975585192419 .PatternTintAndShade = 0 End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone   End If   End Sub

---

Merci d'avance.

Cordialement.

Eureka !

En cherchant sur d'autres posts, j'ai trouvé ceci :

En remplaçant

Code:

---

1 2	Sheets("Autres données").Select Range("A33").Select

---

Par

Code:

---

1 2	Sheets("Autres données").Select Sheets("Autres données").Range("A33").Select

---

ça fonctionne parfaitement !

Il suffit de le savoir.

Merci encore pour votre aide.

Cordialement.