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

L

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
sylvanu
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))...
Trier par date Trier par votes
youky(BJ)

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
 
Vote positif 0 Vote négatif
sylvanu

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
Vote positif 0 Vote négatif
Solution
L

Linda42

XLDnaute Occasionnel
sylvanu à dit:
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);"""")"
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
L

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
 
Vote positif 0 Vote négatif
L

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

sylvanu à dit:
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 ?
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
sylvanu

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.
 
Vote positif 0 Vote négatif

Discussions similaires

N
  • Question
Microsoft 365 Affichage information de plusieurs cellules à partir d'une seule
Réponses
8
Affichages
173
narkoleptik
N
O
  • Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
416
olivieroma
O
R
  • Question
Microsoft 365 RESOLU Récupération plusieurs informations dans une cellule et remplir un autre tableau
2
Réponses
27
Affichages
727
Cousinhub
Cousinhub
C
  • Question
XL 2021 Cellules qui ne s'effacent pas sur formulaire et renvoi de valeurs du formulaire
Réponses
1
Affichages
296
gbinforme
G
G
  • Question
XL 2021 rassembler des données de plusieurs feuilles d'un classeur sur une nouvelle feuille du meme classeur selon un critère
Réponses
1
Affichages
374
Staple1600
Staple1600
C
  • Question
Microsoft 365 Répétition action sur plusieurs feuille d'un classeur
Réponses
4
Affichages
468
sylvanu
sylvanu
L
  • Résolu(e)
Microsoft 365 VBA - Attribuer mise en forme en fonction de valeur cellule d'une liste
Réponses
14
Affichages
624
Laliepomm
L
S
  • Question
XL 2019 besoin d aide pour le développement d'un fichier rangements vers les répertoires attitré
Réponses
6
Affichages
370
stef60400
S
C
  • Question
XL 2016 rapatrier des informations en "scannant" les onglets d'un fichier excel vers les cellules d'un autre onglet
Réponses
6
Affichages
670
job75
job75
Z
  • Résolu(e)
Microsoft 365 Récupérer les éléments d'une liste en fonction de leur position
Réponses
2
Affichages
482
Zarnir
Z

Membres actuellement en ligne

8 membres et 98 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 486
Messages
2 110 107
Membres
110 667
dernier inscrit
andco