XL 2019 réduire vba

Quicksland

XLDnaute Occasionnel
Bonjour a tous ;)

Comment réduire la longueur de cette macro

Sub donnéés1()
'
' donnéés1 Macro
'

'
Range("I2:I4").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R13C2"
Range("I5:I6").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R14C5"
Range("F7:I8").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R6C13"
Range("H9:I10").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R15C5"
Range("H11:I12").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R16C5"
Range("D5:E6").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R10C5"
Range("D21:G21").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R3C9"
Range("D22").Select
ActiveWindow.SmallScroll ToRight:=6
Range("Q2:Q4").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R19C2"
Range("Q5:Q6").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R20C5"
Range("N7:Q8").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R6C13"
Range("P9:Q10").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R21C5"
Range("P11:Q12").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R22C5"
Range("L5:M6").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R10C5"
Range("L21:O21").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R3C9"
Range("L22").Select
ActiveWindow.SmallScroll ToRight:=7
Range("Y2:Y4").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R25C2"
Range("Y5:Y6").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R26C5"
Range("V7:Y8").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R6C13"
Range("X9:Y10").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R27C5"
Range("X11:Y12").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R28C5"
Range("T5:U6").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R10C5"
Range("T21:W21").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R3C9"
Range("T22").Select
ActiveWindow.SmallScroll ToRight:=7
Range("AG2:AG4").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R31C2"
Range("AG5:AG6").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R32C5"
Range("AD7:AG8").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R6C13"
Range("AF9:AG10").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R33C5"
Range("AF11:AG12").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R34C5"
Range("AB5:AC6").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R10C5"
Range("AB21:AE21").Select
ActiveCell.FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R3C9"
Range("AB22").Select
End Sub


Merci d'avance pour l'aide 👍
 
Solution
Bonsoir Quicksland, Phil,
En utilisant un array, on peut réduire la taille :
VB:
Sub Données()
    ' Tableau est organisé avec Plage à écrire, virgule, Plage à lire
    Tablo = Array("I2:I4", "B13", "I5:I6", "E14", "F7:I8", "M6", "H9:I10", "E15", _
                "H11:I12", "E16", "D5:E6", "E10", "D21:G21", "I3", "Q2:Q4", "B19", _
                "Q5:Q6", "E20", "N7:Q8", "M6", "P9:Q10", "E21", "P11:Q12", "E22", _
                "L5:M6", "E10", "L21:O21", "I3", "Y2:Y4", "B25", "Y5:Y6", "E26", _
                "V7:Y8", "M6", "X9:Y10", "E27", "X11:Y12", "E28", "T5:U6", "E10", _
                "T21:W21", "I3", "AG2:AG4", "B31", "AG5:AG6", "E32", "AD7:AG8", _
                "M6", "AF9:AG10", "E33", "AF11:AG12", "E34", "AB5:AC6", "E10", _...

Phil69970

XLDnaute Barbatruc
Bonjour @Quicksland

Remarque :
- Mets le code entre les balises c'est largement plus digeste !
1654372838190.png


Juste comme cela le code est 2 fois moins long o_O

VB:
Sub donnéés1()

Range("I2:I4").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R13C2"
Range("I5:I6").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R14C5"
Range("F7:I8").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R6C13"
Range("H9:I10").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R15C5"
Range("H11:I12").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R16C5"
Range("D5:E6").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R10C5"
Range("D21:G21").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R3C9"
Range("Q2:Q4").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R19C2"
Range("Q5:Q6").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R20C5"
Range("N7:Q8").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R6C13"
Range("P9:Q10").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R21C5"
Range("P11:Q12").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R22C5"
Range("L5:M6").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R10C5"
Range("L21:O21").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R3C9"
Range("Y2:Y4").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R25C2"
Range("Y5:Y6").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R26C5"
Range("V7:Y8").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R6C13"
Range("X9:Y10").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R27C5"
Range("X11:Y12").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R28C5"
Range("T5:U6").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R10C5"
Range("T21:W21").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R3C9"
Range("AG2:AG4").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R31C2"
Range("AG5:AG6").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R32C5"
Range("AD7:AG8").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R6C13"
Range("AF9:AG10").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R33C5"
Range("AF11:AG12").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R34C5"
Range("AB5:AC6").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R10C5"
Range("AB21:AE21").FormulaR1C1 = "='[1 CAMUS LA RIBAMBELLE 1.xlsm]PRINTEMPS '!R3C9"

Range("AB22").Select
End Sub

Si la solution te satisfait n'oublie pas de la valider

*Merci de ton retour

@Phil69970
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Quicksland, Phil,
En utilisant un array, on peut réduire la taille :
VB:
Sub Données()
    ' Tableau est organisé avec Plage à écrire, virgule, Plage à lire
    Tablo = Array("I2:I4", "B13", "I5:I6", "E14", "F7:I8", "M6", "H9:I10", "E15", _
                "H11:I12", "E16", "D5:E6", "E10", "D21:G21", "I3", "Q2:Q4", "B19", _
                "Q5:Q6", "E20", "N7:Q8", "M6", "P9:Q10", "E21", "P11:Q12", "E22", _
                "L5:M6", "E10", "L21:O21", "I3", "Y2:Y4", "B25", "Y5:Y6", "E26", _
                "V7:Y8", "M6", "X9:Y10", "E27", "X11:Y12", "E28", "T5:U6", "E10", _
                "T21:W21", "I3", "AG2:AG4", "B31", "AG5:AG6", "E32", "AD7:AG8", _
                "M6", "AF9:AG10", "E33", "AF11:AG12", "E34", "AB5:AC6", "E10", _
                "AB21:AE21", "I3")
    Set Chemin = Workbooks("1 CAMUS LA RIBAMBELLE 1.xlsm").Worksheets("PRINTEMPS")
    For i = 0 To UBound(Tablo) Step 2
        Range(Tablo(i)).FormulaR1C1 = Chemin.Range(Tablo(i + 1))
    Next i
End Sub
 

Quicksland

XLDnaute Occasionnel
Bonsoir Quicksland, Phil,
En utilisant un array, on peut réduire la taille :
VB:
Sub Données()
    ' Tableau est organisé avec Plage à écrire, virgule, Plage à lire
    Tablo = Array("I2:I4", "B13", "I5:I6", "E14", "F7:I8", "M6", "H9:I10", "E15", _
                "H11:I12", "E16", "D5:E6", "E10", "D21:G21", "I3", "Q2:Q4", "B19", _
                "Q5:Q6", "E20", "N7:Q8", "M6", "P9:Q10", "E21", "P11:Q12", "E22", _
                "L5:M6", "E10", "L21:O21", "I3", "Y2:Y4", "B25", "Y5:Y6", "E26", _
                "V7:Y8", "M6", "X9:Y10", "E27", "X11:Y12", "E28", "T5:U6", "E10", _
                "T21:W21", "I3", "AG2:AG4", "B31", "AG5:AG6", "E32", "AD7:AG8", _
                "M6", "AF9:AG10", "E33", "AF11:AG12", "E34", "AB5:AC6", "E10", _
                "AB21:AE21", "I3")
    Set Chemin = Workbooks("1 CAMUS LA RIBAMBELLE 1.xlsm").Worksheets("PRINTEMPS")
    For i = 0 To UBound(Tablo) Step 2
        Range(Tablo(i)).FormulaR1C1 = Chemin.Range(Tablo(i + 1))
    Next i
End Sub
Bonsoir Sylvanu ;)
Merci pour ton intervention 👍
C'est vraiment top !
 

Quicksland

XLDnaute Occasionnel
Bonjour,
En lisant votre réponse j'ai vu une maladresse dans le code, le formulaR1C1 ne sert évidemment plus à rien puisqu'on colle la valeur,
Donc vous pouvez mettre simplement :
VB:
Range(Tablo(i)) = Chemin.Range(Tablo(i + 1))
Bonjour Sylvanu

Ok mais j'ai quand même un soucis cela ne fonctionne pas :rolleyes:

Dois-je affecté la macro a un bouton ou cela fonctionne automatiquement !?

Je te joint les fichiers ...

Merci pour ton aide 👍
 

Pièces jointes

  • 1 CAMUS LA RIBAMBELLE 1.xlsm
    142.2 KB · Affichages: 2
  • FICHE PIC NIC 1 S P.xlsm
    504.7 KB · Affichages: 4

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
1- Le VBA ne supporte pas les approximations. 😅😂🤣
Votre fichier s'appelle : "1 CAMUS LA RIBAMBELLE 1.xlsm" et non pas "1 CAMUS LA RIBAMBELLE 1.xlsm"
Votre onglet s'appelle : "PRINTEMPS " et non pas "PRINTEMPS"
Le mieux est de virer ces espaces superflus, double espace dans le nom, espace à la fin du nom de l'onglet, c'est une maladresse qui généralement est très chronophage pour débusquer les erreurs car les espaces sont visuellement invisibles.
2- Ensuite, tel qu'écrit il demande un bouton.
Ensuite tout dépend de votre contexte. Le faire en automatique à la sélection d'un onglets fera que vous l'exécuterez à chaque fois. Est ce nécessaire ?
On peut aussi faire une seule fois la mise à jour de tous les onglets à l'ouverture du fichier.
Tout ça dépends de vous, même on sort du titre de ce fil, car c'est un autre problème.
En PJ j'ai juste corriger Mardi, avec accès macro par bouton pour test, pour vérifier que la macro passe sans planter.
 

Pièces jointes

  • FICHE PIC NIC 1 S P.xlsm
    551.1 KB · Affichages: 1

Quicksland

XLDnaute Occasionnel
Bonjour,
1- Le VBA ne supporte pas les approximations. 😅😂🤣
Votre fichier s'appelle : "1 CAMUS LA RIBAMBELLE 1.xlsm" et non pas "1 CAMUS LA RIBAMBELLE 1.xlsm"
Votre onglet s'appelle : "PRINTEMPS " et non pas "PRINTEMPS"
Le mieux est de virer ces espaces superflus, double espace dans le nom, espace à la fin du nom de l'onglet, c'est une maladresse qui généralement est très chronophage pour débusquer les erreurs car les espaces sont visuellement invisibles.
2- Ensuite, tel qu'écrit il demande un bouton.
Ensuite tout dépend de votre contexte. Le faire en automatique à la sélection d'un onglets fera que vous l'exécuterez à chaque fois. Est ce nécessaire ?
On peut aussi faire une seule fois la mise à jour de tous les onglets à l'ouverture du fichier.
Tout ça dépends de vous, même on sort du titre de ce fil, car c'est un autre problème.
En PJ j'ai juste corriger Mardi, avec accès macro par bouton pour test, pour vérifier que la macro passe sans planter.
Re bonjour

Ah beh la je ne suis pas sorti de l'auberge :rolleyes:

En fait je préférai une mise à jour de tout les onglets a l'ouverture du fichier 👍

J'ai vu que tu avais ajouté une feuille dans la macro ( feuil1) normal !?

serait il possible de renommer " Sub données () " en " Sub données 1 car il va y avoir plusieurs source par la suite

N'est il pas possible aussi qu'au lieu d'avoir ceci ("I2:I4", "J13", "I5:I6", "M14", "F7:I8", "M6", "H9:I10", "M15", _ ) mais plutôt ceci
("I2:I4", "J13", "I5:I6", "M14", "F7:I8", "M6", "H9:I10", "M15", "H11:I12", "M16", "D5:E6", "M10", "D21:G21", "I3",_) ce qui correspondrai a 1 numéro de pic nic par ligne

Merci pour tout ton aide
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
La macro en Feuil1 n'est qu'un résidu de travail, totalement inutile. C'tait juste un fichier de test.
Le " _" n'est qu'un retour à la ligne pour améliorer la lisibilité. Vous pourriez même mettre tout sur une ligne, ça n'a aucune importance.
Quand aux noms des macros, il est sans aucune importance pour des macros "normales".
Pour d'autres dites événementielles elles doivent absolument porter un nom qu'XL reconnait.
Pour que la macro s'exécute à l'ouverture du fichier, vous mettez dans le dossier ThisWorkbook la macro suivante :
VB:
Private Sub Workbook_Open()
     ' Votre Code Macro
End Sub
Elle sera exécuter à l'ouverture. Attention le nom Workbook_Open ne doit pas être modifié, il doit impérativement s'appeler ainsi, ce qui permet à XL de savoir ce qu'il doit exécuter en automatique.
Ainsi vous avez aussi à la fermeture du fichier le même type de macro :
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     ' Votre Code Macro
End Sub
 

Quicksland

XLDnaute Occasionnel
Re,
La macro en Feuil1 n'est qu'un résidu de travail, totalement inutile. C'tait juste un fichier de test.
Le " _" n'est qu'un retour à la ligne pour améliorer la lisibilité. Vous pourriez même mettre tout sur une ligne, ça n'a aucune importance.
Quand aux noms des macros, il est sans aucune importance pour des macros "normales".
Pour d'autres dites événementielles elles doivent absolument porter un nom qu'XL reconnait.
Pour que la macro s'exécute à l'ouverture du fichier, vous mettez dans le dossier ThisWorkbook la macro suivante :
VB:
Private Sub Workbook_Open()
     ' Votre Code Macro
End Sub
Elle sera exécuter à l'ouverture. Attention le nom Workbook_Open ne doit pas être modifié, il doit impérativement s'appeler ainsi, ce qui permet à XL de savoir ce qu'il doit exécuter en automatique.
Ainsi vous avez aussi à la fermeture du fichier le même type de macro :
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     ' Votre Code Macro
End Sub
Re,

Ok pour le résidu d'un test ;)

J'ai séparé le code en 4 car quatre tableaux ( plus facile pour repérer une erreur )

J'ai bien compris pour le nom des macros 👍 ( j'ai renommé données1, données2 ....données 10 au final )

Mais mon problème est avec ThisWorkbook car pour l'instant mes codes sont dans chaque feuilles
soit feuil1 lundi feuil 2 mardi feuil 3 mardi ect
exemple feuil 1 lundi j'ai données1, données2 et cela jusqu'à 10
alors si je comprend bien
je devrais mettre les dix codes de lundi dans le ThisWorkbook puis a la suite les dix de mardi ect ?

Je te remet le fichier avec modification si plus clair pour toi :rolleyes:
 

Pièces jointes

  • FICHE PIC NIC 1 S P.xlsm
    511.4 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
1- Je ne comprends pas, vous mettez la solution retenue en post #2 mais vous utilisez le code du post #4, le futur lecteur va s'y perdre.
2- Comme je vous l'ai dit, votre nouvelle problématique n'a rien çà voir avec le titre de ce post : "réduire VBA"
Donc créez un nouveau post. XLD est aussi une formidable base de données, cela suppose qu'un fil ne mélange pas plusieurs problèmes, sinon le futur lecteur ne pourra pas faire de recherche sur ce nouveau problème.
 

Quicksland

XLDnaute Occasionnel
Bonjour,
1- Je ne comprends pas, vous mettez la solution retenue en post #2 mais vous utilisez le code du post #4, le futur lecteur va s'y perdre.
2- Comme je vous l'ai dit, votre nouvelle problématique n'a rien çà voir avec le titre de ce post : "réduire VBA"
Donc créez un nouveau post. XLD est aussi une formidable base de données, cela suppose qu'un fil ne mélange pas plusieurs problèmes, sinon le futur lecteur ne pourra pas faire de recherche sur ce nouveau problème.
ok désolé !
Votre solution est beaucoup plus courte et simple et j'ai cocher le post 2 avant votre solution ...
et vu que vous aviez déjà pas mal d'info j'ai trouvé plus simple et pratique de continuer avec vous ;);)
Merci pour votre aide
 

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib