XL 2010 Copier les resultats de calcul lié à un menu deroulant

davy76

XLDnaute Nouveau
Bonjour,

J aimerais savoir si il est possible de copier dans un tableau de synthèse les résultats liés à des calculs qui bouge en fonction d'un menu déroulant.
Pour l'exemple, a chaque fois que je change la donnée du menu déroulant cellule jaune, un calcul se fait dans les cellules vert.
J'aimerais que le résultat soit copier dans un tableau de synthèse en bleu sur la ligne correspondant au lien en jaune.
J'espère avoir été clair.
Merci pour vos conseils.
 

Pièces jointes

  • Test calcul.xlsx
    18.3 KB · Affichages: 19
Solution
Voyez le fichier joint et ces 2 macros dans le code de la feuille "Synthese" :
VB:
Private Sub Worksheet_Activate()
Dim F As Worksheet, mem, P As Range, i&
Set F = Sheets("Eval 2020")
mem = F.[H26]
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If [B1] = "" Then [B1] = "CHM"
Set P = IIf(UCase([B1]) = "CHM", F.[G44:G56], F.[L44:L56])
Range("B3:N" & Rows.Count).ClearContents 'RAZ
For i = 1 To Application.CountA([A:A]) - 2
    F.Range("H26") = Range("A2").Offset(i)
    Range("B2:N2").Offset(i) = Application.Transpose(P)
Next
F.[H26] = mem
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Activate 'lance la macro
End Sub

davy76

XLDnaute Nouveau
Merci pour ta réponse, mais je me rend compte que je n'ai pas été tres clair dans mon explication.
En fait, dans le menu déroulant tu dois choisir le lien (LIEN 1, LIEN 2,....)
Celui, ci ira chercher les valeurs correspondants a la ligne et fera le calcul a, b, c, d,...
j'aimerais que ces résultats aille ensuite ce copier dans le tableau de synthese sur la ligne correspondant au LIEN sur la Feuil 1. Exemple les résultats a,b,c,d vont se coller pour le LIEN 1 en Cellule L2 à T2. Pour le LIEN 2 en CELLULE L3 à T3. Et ainsi de suite.
Car dans mon tableau d'origine, je ne veux copier que le resultat de mes calculs, je ne peux pas utiliser les valeurs qui compose le calcul car il y a trop de variable.
je ne sais pas si j ai été plus clair.
Mais merci de ton aide.
 

job75

XLDnaute Barbatruc
Bonsoir davy76, JHA,

Oui il faut du VBA pour remplir le tableau de synthèse.

Voyez le fichier joint et cette macro dans le code de la feuille "TEST" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mem, P As Range, i&
mem = [C2]
Application.ScreenUpdating = False
Application.EnableEvents = False
If [K2] = "" Then [K2] = "nbr1"
Set P = [E4:E12].Offset(, Right([K2], 1))
For i = 1 To 18
    Range("C2") = "LIEN " & i
    Range("K3:S3").Offset(i) = Application.Transpose(P)
Next
[C2] = mem
Application.EnableEvents = True
End Sub
Elle se déclenche quand on modifie une cellule quelconque.

Nota : j'ai fait le plus simple possible.

A+
 

Pièces jointes

  • Test calcul essai(1).xlsm
    23.2 KB · Affichages: 10

davy76

XLDnaute Nouveau
Bonjour Job75,

Merci a toi, c'est exactement ce que je cherche et maintenant si le tableau de synthèse est sur un autre onglet comme dans le fichier joint. Comment je procède ?
 

Pièces jointes

  • Copie de Test calcul essai(1).xlsm
    23.4 KB · Affichages: 3

davy76

XLDnaute Nouveau
Et du coup deuxième question, comme il s'agit d'un fichier générique j'ai mis LIEN 1, LIEN2, LIEN 3 mais comment je fais pour y mettre les vrai intitulé? Car une fois que je change ca ne fonctionne plus le VBA fait référence au nom "LIEN"
 

job75

XLDnaute Barbatruc
Bonjour davy76,

Fichier (2) et la macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mem, P As Range, F As Worksheet, i&
mem = [C2]
Application.ScreenUpdating = False
Application.EnableEvents = False
If [K2] = "" Then [K2] = "nbr1"
Set P = [E4:E12].Offset(, Right([K2], 1))
Set F = Sheets("Synthese")
For i = 1 To 18
    Range("C2") = F.Range("A2").Offset(i)
    F.Range("B2:J2").Offset(i) = Application.Transpose(P)
Next
[C2] = mem
Application.EnableEvents = True
End Sub
A+
 

Pièces jointes

  • Test calcul essai(2).xlsm
    24.3 KB · Affichages: 2

job75

XLDnaute Barbatruc
Il est plus simple d'utiliser cette macro dans le code de la feuille "Synthese", fichier (3) :
VB:
Private Sub Worksheet_Activate()
Dim F As Worksheet, mem, P As Range, i&
Set F = Sheets("Test")
mem = F.[C2]
Application.ScreenUpdating = False
If F.[K2] = "" Then F.[K2] = "nbr1"
Set P = F.[E4:E12].Offset(, Right(F.[K2], 1))
For i = 1 To 18
    F.Range("C2") = Range("A2").Offset(i)
    Range("B2:J2").Offset(i) = Application.Transpose(P)
Next
F.[C2] = mem
End Sub
Elle se déclenche quand on active la feuille.
 

Pièces jointes

  • Test calcul essai(3).xlsm
    25.9 KB · Affichages: 2

davy76

XLDnaute Nouveau
Merci a toi, mais je suis vraiment nul je n'arrive pas a le retransposé dans mon fichier.
faut vraiment que je comprenne lol.
Je t'envoi mon fichier si tu arrives a me faire la même chose mais avec le vrai fichier.
Dans la synthèse je dois pouvoir choisir 2 références en A2 comme pour le fichier test en K2.
Et en fonction de ce choix il va copier soit les cellules G44 à G55 ou L44 à L55 dans la synthèse.
Merci a toi encore une fois.
 

Pièces jointes

  • Outils vba.xlsm
    592.9 KB · Affichages: 2

job75

XLDnaute Barbatruc
Voyez le fichier joint et ces 2 macros dans le code de la feuille "Synthese" :
VB:
Private Sub Worksheet_Activate()
Dim F As Worksheet, mem, P As Range, i&
Set F = Sheets("Eval 2020")
mem = F.[H26]
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If [B1] = "" Then [B1] = "CHM"
Set P = IIf(UCase([B1]) = "CHM", F.[G44:G56], F.[L44:L56])
Range("B3:N" & Rows.Count).ClearContents 'RAZ
For i = 1 To Application.CountA([A:A]) - 2
    F.Range("H26") = Range("A2").Offset(i)
    Range("B2:N2").Offset(i) = Application.Transpose(P)
Next
F.[H26] = mem
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Activate 'lance la macro
End Sub
 

Pièces jointes

  • Outils vba(1).xlsm
    595.5 KB · Affichages: 6

Discussions similaires

Réponses
1
Affichages
370

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof