Eviter d'utiliser un bouton à chaque semaine pour activer la même macro
Bonjour à tous,
J'aimerais que si, dans la colonne "S" de chaque semaine (Sem.01, Sem.02....) se trouve un "3", le nom vis-à-vis le "3" dans la colonne "C", s'inscrive dans les cellules blanches des lignes 25, 26, 27, de l'onglet "Budgets hebdomadaires", à chaque semaine.
Je voudrais que les noms s'inscrivent lors de l'activation de la macro "Transfert" en utilisant la fonction "Call" suivi du nom de la nouvelle macro (SoixanteNeuf). J'utilise beaucoup cette fonction dans mon fichier principal et ça fonctionne très bien.
Mon fichier principal contient 34 semaines et peut contenir de 16 à 24 équipes.
Note: Je n'ai pas créé la macro "Transfert". Elle m'a été fournie par un des participant du Forum, il y a ce ça une dizaine d'année. Je ne voudrais pas offusquer ou fâcher personne en vous donnant cette information. Je peux créer des macros simples mais je n'ai pas la connaissance pour créer des macros très complexes. Sans les avoir créées, je peux les comprendre et les adapter à mes besoins.
Merci beaucoup de votre compréhension et de votre aide.
Bonsoir Golfeur, bonsoir le forum,
Deux choses :
1. Je n'ai pas trouvé la macro Transfert dans ton fichier ?!...
2. les cellules blanches des lignes 25 à 27 s’étalent sur six colonnes par semaine. En semaine 0,1par exemple, les colonnes sont C, D, E et G, H, I. Tu voudrais renvoyer les noms dans toutes ces colonnes ? Si non, dans lesquelles ?
Bonjour Thau Thème,
Merci pour l'intérêt que tu portes à mon fichier.
Milles excuses, le bouton s'appelle "Transfert" mais la macro se nomme "Standar". En cliquant sur le bouton "Transfert" la macro Standar" transfère les données à la semaine suivante.
Chacun des noms vis-à-vis les "chiffres 3" de la col. "S" doivent se trouver dans les cellules blanches de chaque semaine.
Exemple : Si dans la Sem.01 il y a deux "3" dans la col. "S", les deux noms de la col. "C" vis-à-vis les "chiffres 3" doivent s'inscrire dans les cellules blanches C25, C26 de l'onglet "Budgets hebdomadaires". Il n'y aura jamais plus que six noms à chaque semaine.
Si dans la Sem.02 il y a quatre "3" dans la col. "S", les quatre noms de la col. "C" vis-à-vis les chiffres "3" doivent s'inscrire dans les cellules blanches de la Sem.02 : P25, P26, P27 et T25 de l'onglet "Budgets hebdomadaires".
Si dans la Sem.03 il y a six "3" dans la col. "S", les six noms de la col. "C" vis-à-vis les chiffres "3" doivent s'inscrire dans les cellules blanches de la Sem.03 : AC25, AC26, AC27 et AG25, AG26, AG27 de l'onglet "Budgets hebdomadaires".
Comme mon fichier principal contient 34 semaines, les dernières cellules blanches se trouvent dans les cellules PP25, PP26, PP27 et PT25, PT26, PT27.
En espérant que les nouvelles infos. seront suffisantes pour que tu puisses trouver une solution, si elle existe....
Merci encore pour l'intérêt que tu portes à mon fichier.
Passe une belle journée.
Bonsoir Golfeur, bonsoir le forum,
Essaie comme ça :
Sub Macro1()
Dim BH As Worksheet 'déclare la variable BH (onglet Budgets Hebdomadaires)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim R As Range 'déclare la variable R (Recherche)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Byte 'déclare la variable K (incrément)
Dim TL(1 To 3) As Variant 'déclare la variable TL (tableau de 3 lignes)
Set BH = Worksheets("Budgets hebdomadaires") 'définit l'onglet BH
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeurs
K = 0 'initialise la variable K
If Left(O.Name, 3) = "Sem" Then 'condition 1 : si le nom de l'onglet O commence par "Sem"
Set R = BH.Rows(1).Find(O.Name) 'définit la recherche R (recherche le nom de l'onglet O dans la première ligne de l'onglet BH)
If Not R Is Nothing Then 'condition 2 : si au moins une occurrence est trouvée
Set DEST = R.Offset(24, 1) 'définit la cellue de destination DEST
DL = O.Cells(Application.Rows.Count, "S").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne S de l'onglet O
TV = O.Range("A1:S" & DL) 'définit la tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
If TV(I, 19) = 3 Then 'condition 3 : si la donnée ligne I colonne 19 (=> colonne S) de TV est égale à 3
J = J + 1 'incrémente J
K = K + 1 'incrémente K
If K > 6 Then GoTo suite 'si K est supérieure à 6, va à l'étiquette "suite"
TL(J) = TV(I, 3) 'récupère dans la ligne J de TL la donnée en colonne 3 de TV (le nom du joueurs)
DEST.Resize(J, 1) = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
If J = 3 Then 'condition 4 : si J est égale à 3
Set DEST = DEST.Offset(0, 4) 'redéfinit la cellule de destination DEST
Erase TL 'vide le tableau TL
J = 0 'réinitialise la variable J
End If 'fin de la condition 4
End If 'fin de la condition 3
Next I 'prochaine ligne de la boucle 2
End If 'fin de la condition 2
End If 'fin de la condition 1
suite: 'étiquette
Next O 'prochain onglet de la boucle 2
End SubBonjour Thau Thème,
Merci pour ta réponse rapide.
Ta macro fonctionne très bien sauf lorsque qu'il y a cinq "3" qui se suivent dans la même équipe. (Voir Sem.03 et Sem.05 dans le fichier en pièce jointe. Ça semble créer un bog.
Merci encore et bonne soirée. (Ici il est 15 hr.)
Bonjour Golfeur, bonjour le forum,
Oui désolé en effet j'avais oublié de réinitialiser certaines variables. C'est bien visible quand on fournit un fichier qui contient toutes les données
Le code modifié :
Sub SoixanteNeuf()
Dim BH As Worksheet 'déclare la variable BH (onglet Budgets Hebdomadaires)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim R As Range 'déclare la variable R (Recherche)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Byte 'déclare la variable K (incrément)
Dim TL(1 To 3) As Variant 'déclare la variable TL (tableau de 3 lignes)
Set BH = Worksheets("Budgets hebdomadaires") 'définit l'onglet BH
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeurs
J = 0'initialise la variable J
K = 0 'initialise la variable K
Erase TL 'vide la tableau TL
If Left(O.Name, 3) = "Sem" Then 'condition 1 : si le nom de l'onglet O commence par "Sem"
Set R = BH.Rows(1).Find(O.Name) 'définit la recherche R (recherche le nom de l'onglet O dans la première ligne de l'onglet BH)
If Not R Is Nothing Then 'condition 2 : si au moins une occurrence est trouvée
Set DEST = R.Offset(24, 1) 'définit la cellue de destination DEST
DL = O.Cells(Application.Rows.Count, "S").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne S de l'onglet O
TV = O.Range("A1:S" & DL) 'définit la tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
If TV(I, 19) = 3 Then 'condition 3 : si la donnée ligne I colonne 19 (=> colonne S) de TV est égale à 3
J = J + 1 'incrémente J
K = K + 1 'incrémente K
If K > 6 Then GoTo suite 'si K est supérieure à 6, va à l'étiquette "suite"
TL(J) = TV(I, 3) 'récupère dans la ligne J de TL la donnée en colonne 3 de TV (le nom du joueurs)
DEST.Resize(J, 1) = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
If J = 3 Then 'condition 4 : si J est égale à 3
Set DEST = DEST.Offset(0, 4) 'redéfinit la cellule de destination DEST
Erase TL 'vide le tableau TL
J = 0 'réinitialise la variable J
End If 'fin de la condition 4
End If 'fin de la condition 3
Next I 'prochaine ligne de la boucle 2
End If 'fin de la condition 2
End If 'fin de la condition 1
suite: 'étiquette
Next O 'prochain onglet de la boucle 2
End SubBonjour Thau Thème,
Merci encore pour ta réponse rapide. Tout fonctionne parfaitement dans le fichier "classeur-1" que je t'ai fait parvenir. J'ai transféré la macro dans mon système principal qui est beaucoup plus volumineux, et ça ne fonctionne pas. J'ai tout essayé (du mieux de mes connaissances) et rien ne fonctionne. Je ne comprend pas pourquoi, car le Classeur-1 contient les mêmes paramètres, en plus petit que mon fichier principal.
Si tu le permets, je pourrais t'envoyer mon fichier principal en privé via Ci-Joint afin que tu puisses vérifié ou est mon erreur.
SVP laisse moi savoir.
Merci et bonne soirée.
Re,
Je t'ai répondu par mail perso...
Bonjour Thau Thème,
Merci beaucoup pour ta participation. Tout fonctionne parfaitement bien.
Je ferme le dossier.
Passe une belle journée.
Bonjour ThauThème,
Comme c'est toi qui a résolu mon problème la première fois, je me permet de te revenir car j'ai du faire quelque modification à mon système principale.
La macro fonctionne très bien dans le fichier en pièce jointe, même avec les modifications que j'ai appliquées à ta macro. Je m'explique :
Comme il y a maintenant 24 équipes plutôt que 18,
1ière modification : (DEST = R.Offset (24, 1) EST CHANGÉ POUR (DEST = R.Offset (30, 1) . Ça fonctionne parfaitement.
2ième modification : Je dois changer la source de Col. "S" à Col. "AG" (DL = O.Cells(Application.Rows.Count, "S").End(xlUp).Row) EST CHANGÉ POUR (DL =O.Cells(Application.Rows.Count, "AG") .
3ième modification : Comme la source est maintenant la Col "AG" la Col Source devient 33 plutôt que 19 (If TV(I, 19) = 3 Then) EST CHANGÉ POUR (If TV(I, 33 = 3 Then).
Lorsque j'active la macro dans mon système principal, elle me demande un "Débogage" à la ligne suivante: (If TV(I, 33) = 3 Then 'condition 3)
même si le résultat est bon. Je ne comprend pas pourquoi le "débogage" alors que le résultat est ce que je recherche.
Si ça te tente, peux tu SVP regarder et me revenir.
Merci beaucoup pour ton aide.