XL 2016 recopier les informations d'une feuille vers plusieurs autre du même classeur

Linda42

XLDnaute Occasionnel
Bonjour,

J'ai besoin de votre aide pour un code VBA (compatible avec ceux déjà existant) pour récupérer les informations siaisies sur la feuille "Formulaire de saisie" et reporter l'information dans différentes feuilles. La solution que j'ai trouver était une simple formule de récupération de la donnée mais je rencontre une problématique de mise en page.

En effet, j'ai mis un code qui doit ajuster toutes les hauteurs de ligne en fonction du contenu mais cela ne fonctionne pas avec les céllules ou il y a des fourmules, Donc plutôt que de mettre des formule,s je souhaite mettre un code vba pour copier / coller les valeurs afin de réupérér les infos et permertte à mon code vba d'ajuster la hauteur de la ligne en fonction du contenu et plus de la formule.

Sur les autre feuilles, les cellules concernées, ou il y a des formules sont celles en grise.

Merci pour votre aide.
Linda
 

Pièces jointes

  • essaiFiches Stratégie_Choix_Performance_V2.xlsm
    948.4 KB · Affichages: 4
Solution
Bonjour Linda, Youky,
La même approche mais légèrement différent, toujours avec Worksheet_Activate :
VB:
Sub Worksheet_Activate()
Worksheets("Fiche Stratégie").Unprotect
With Sheets("Formulaire de saisie")
    ' Remplissage Tablo : Cellule De Fiche stratégie, virgule puis Cellule à copier de Formulaire
    Tablo = Array("N5", "L23", "E7", "L25", "E8", "L27", "E9", "L29", "O7", "L31", "O8", "L33", "O9", "L35", _
                    "I11", "L38", "I12", "L40", "L28", "L44", "L29", "L46", "F60", "L42", "D62", "L62", "K62", _
                    "L64", "C144", "L60", "K171", "L56", "C199", "B69", "C201", "B71")
    For i = LBound(Tablo) To UBound(Tablo) Step 2
        If .Range(Tablo(i + 1)) <> "" Then Range(Tablo(i)) = .Range(Tablo(i + 1))...

youky(BJ)

XLDnaute Barbatruc
Bonjour Linda42,
Dans le code de l'onglet Fiche stratégie coller ceci en bas de vos macros
Bien sur if faudra faire les autres cellules j'avais la flegme.

Private Sub Worksheet_Activate()
[N5] = Feuil7.[L23]
[E7] = Feuil7.[L25]
[E8] = Feuil7.[L27]
''et la suite
End Sub

Bruno du 69
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Linda, Youky,
La même approche mais légèrement différent, toujours avec Worksheet_Activate :
VB:
Sub Worksheet_Activate()
Worksheets("Fiche Stratégie").Unprotect
With Sheets("Formulaire de saisie")
    ' Remplissage Tablo : Cellule De Fiche stratégie, virgule puis Cellule à copier de Formulaire
    Tablo = Array("N5", "L23", "E7", "L25", "E8", "L27", "E9", "L29", "O7", "L31", "O8", "L33", "O9", "L35", _
                    "I11", "L38", "I12", "L40", "L28", "L44", "L29", "L46", "F60", "L42", "D62", "L62", "K62", _
                    "L64", "C144", "L60", "K171", "L56", "C199", "B69", "C201", "B71")
    For i = LBound(Tablo) To UBound(Tablo) Step 2
        If .Range(Tablo(i + 1)) <> "" Then Range(Tablo(i)) = .Range(Tablo(i + 1))
    Next i
    ' Formule initiale
    '[E30].FormulaLocal = "=SIERREUR(RECHERCHEV($L$28;'3 - Nomenclatures_DGOS_Sept2018'!A:K;8;FAUX);"""")"
    ' Formule modifiée
    [E30].FormulaLocal = "=SIERREUR(RECHERCHEV($L$28;'3 - Nomenclatures_DGOS_Sept2018'!B:K;7;FAUX);"""")"
    [E30] = [E30].Value
End With
Worksheets("Fiche Stratégie").Protect
End Sub
Le tableau fourni les cellules où copier et celles à copier.
La macro s'exécute automatiquement quand on affiche la feuille.
En PJ je ne l'ai fait que pour "Fiche Stratégie"

Par contre votre formule en E30 me semble fausse :
Code:
=SIERREUR(RECHERCHEV($L$28;'3 - Nomenclatures_DGOS_Sept2018'!A:K;8;FAUX);"")
En effet la colonne A de '3 - Nomenclatures_DGOS_Sept2018 est vide.
Je l'ai remplacé pour essai par :
Code:
[E30].FormulaLocal = "=SIERREUR(RECHERCHEV($L$28;'3 - Nomenclatures_DGOS_Sept2018'!B:K;7;FAUX);"""")"
 

Pièces jointes

  • essaiFiches Stratégie_Choix_Performance_V2 (1).xlsm
    960.2 KB · Affichages: 2

Linda42

XLDnaute Occasionnel
Bonjour Linda, Youky,
La même approche mais légèrement différent, toujours avec Worksheet_Activate :
VB:
Sub Worksheet_Activate()
Worksheets("Fiche Stratégie").Unprotect
With Sheets("Formulaire de saisie")
    ' Remplissage Tablo : Cellule De Fiche stratégie, virgule puis Cellule à copier de Formulaire
    Tablo = Array("N5", "L23", "E7", "L25", "E8", "L27", "E9", "L29", "O7", "L31", "O8", "L33", "O9", "L35", _
                    "I11", "L38", "I12", "L40", "L28", "L44", "L29", "L46", "F60", "L42", "D62", "L62", "K62", _
                    "L64", "C144", "L60", "K171", "L56", "C199", "B69", "C201", "B71")
    For i = LBound(Tablo) To UBound(Tablo) Step 2
        If .Range(Tablo(i + 1)) <> "" Then Range(Tablo(i)) = .Range(Tablo(i + 1))
    Next i
    ' Formule initiale
    '[E30].FormulaLocal = "=SIERREUR(RECHERCHEV($L$28;'3 - Nomenclatures_DGOS_Sept2018'!A:K;8;FAUX);"""")"
    ' Formule modifiée
    [E30].FormulaLocal = "=SIERREUR(RECHERCHEV($L$28;'3 - Nomenclatures_DGOS_Sept2018'!B:K;7;FAUX);"""")"
    [E30] = [E30].Value
End With
Worksheets("Fiche Stratégie").Protect
End Sub
Le tableau fourni les cellules où copier et celles à copier.
La macro s'exécute automatiquement quand on affiche la feuille.
En PJ je ne l'ai fait que pour "Fiche Stratégie"

Par contre votre formule en E30 me semble fausse :
Code:
=SIERREUR(RECHERCHEV($L$28;'3 - Nomenclatures_DGOS_Sept2018'!A:K;8;FAUX);"")
En effet la colonne A de '3 - Nomenclatures_DGOS_Sept2018 est vide.
Je l'ai remplacé pour essai par :
Code:
[E30].FormulaLocal = "=SIERREUR(RECHERCHEV($L$28;'3 - Nomenclatures_DGOS_Sept2018'!B:K;7;FAUX);"""")"
Super, cela fonctionne. Je vais dupliquer cette macro pour les autres.

Pour la formule, elle est correcte dans mon fichier. j'ai du réduire la taille pour pouvoir joindre ma pièce jointe dans la conversation et j'ai effacer la colonne A. Par contre je rencontre un problème : la formule est censé renvoyer les éléments de la colonne 8, ce sont des chiffres "." et chiffre. Mais avec la macro cel me renvoie chiffre "," chiffre. Existe-t-il une solution pour concervé le "."?

Merci encore pour votre aide.

Linda
 

Linda42

XLDnaute Occasionnel
Re bonjour,
J'ai dupliqué et cela fonctionne sauf pour la fiche ou je veux insérer plusieurs formules, il doit manqué qq chose dans le code mais n'étant vraiement pas experte, je bloque.
VB:
Sub Worksheet_Activate()
Worksheets("Fiche Performance").Unprotect
With Sheets("Formulaire de saisie")
    ' Remplissage Tablo : Cellule De Fiche stratégie, virgule puis Cellule à copier de Formulaire
    Tablo = Array("k6", "L25", "k8", "L23", "k10", "L27", "k12", "L38", "AE10", "L29", "Y12", "L40", "K15", "L42", _
                    "K292", "L44", "R29", "L46", "62", "L52", "AA62", "L54", "AH62", "L56")
    For i = LBound(Tablo) To UBound(Tablo) Step 2
        If .Range(Tablo(i + 1)) <> "" Then Range(Tablo(i)) = .Range(Tablo(i + 1))
    Next i
    ' Formule initiale
    '[E17].FormulaLocal = "=SIERREUR(RECHERCHEV($L$15;'3 - Nomenclatures_DGOS_Sept2018'!A:K;8;FAUX);"""")"
    ' Formule modifiée
    [K31].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;2;FAUX);"""")"
    [K31] = [K31].Value
    [K32].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;3;FAUX);"""")"
    [K32] = [K32].Value
    [K33].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;4;FAUX);"""")"
    [K33] = [K33].Value
    [K34].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;5;FAUX);"""")"
    [K34] = [K34].Value
    [K35].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;6;FAUX);"""")"
    [K35] = [K35].Value
    [K36].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;7;FAUX);"""")"
    [K36] = [K36].Value
    [K38].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;8;FAUX);"""")"
    [K38] = [K38].Value
    [K39].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;9;FAUX);"""")"
    [K39] = [K39].Value
End With


Worksheets("Fiche Performance").Protect
End Sub

1668503827123.png


Merci
 

Linda42

XLDnaute Occasionnel
Re bonjour,
J'ai dupliqué et cela fonctionne sauf pour la fiche ou je veux insérer plusieur formule.

Sub Worksheet_Activate()
Worksheets("Fiche Performance").Unprotect
With Sheets("Formulaire de saisie")
' Remplissage Tablo : Cellule De Fiche stratégie, virgule puis Cellule à copier de Formulaire
Tablo = Array("k6", "L25", "k8", "L23", "k10", "L27", "k12", "L38", "AE10", "L29", "Y12", "L40", "K15", "L42", _
"K292", "L44", "R29", "L46", "62", "L52", "AA62", "L54", "AH62", "L56")
For i = LBound(Tablo) To UBound(Tablo) Step 2
If .Range(Tablo(i + 1)) <> "" Then Range(Tablo(i)) = .Range(Tablo(i + 1))
Next i
' Formule initiale
'[E17].FormulaLocal = "=SIERREUR(RECHERCHEV($L$15;'3 - Nomenclatures_DGOS_Sept2018'!A:K;8;FAUX);"""")"
' Formule modifiée
[K31].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;2;FAUX);"""")"
[K31] = [K31].Value
[K32].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;3;FAUX);"""")"
[K32] = [K32].Value
[K33].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;4;FAUX);"""")"
[K33] = [K33].Value
[K34].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;5;FAUX);"""")"
[K34] = [K34].Value
[K35].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;6;FAUX);"""")"
[K35] = [K35].Value
[K36].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;7;FAUX);"""")"
[K36] = [K36].Value
[K38].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;8;FAUX);"""")"
[K38] = [K38].Value
[K39].FormulaLocal = "=SIERREUR(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;9;FAUX);"""")"
[K39] = [K39].Value
End With


Worksheets("Fiche Performance").Protect
End Sub

Regarde la pièce jointe 1155372

Bonjour,
Dans Tablo "62" est une erreur. Il manque la colonne. :)
Pour l'autre point je regarde. Il doit le considérer comme un nombre. Mais avec la formule dans la cellule ça marche ?
Effectivement, 🧐 j'aurais du me relire. Merci c'est modifier.
Oui avec la formue dans la cellule ça marche mais le but est de ne plus avoir de formule dans les cellules. Si pas de solution, je la conserverai.

Merci encore
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re, Essayez avec la fonction TEXTE :
VB:
[K31].FormulaLocal = "=SIERREUR(TEXTE(RECHERCHEV($K$29;'3 - Nomenclatures_DGOS_Sept2018'!A:K;2;FAUX);"""@""");"""")"
Qui est censé convertir les nombres en texte. Peut être cela résoudra le problème.
Sinon faites un tout petit fichier test qui montre le problème. Il doit bien y avoir une solution.
 

Discussions similaires