Macro copie de données sélectives dans tablea

Résolu/Fermé
Signaler
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015
-
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015
-
Bonjour,

voiçi un nouveau petit pb !
je voudrais copier des données choisies dans un tableau.
j'ai déjà écrit un début de code mais il bug un peu

si quelqu'un peut m'aider, je l'en remercie d'avance
voici mon code et le fichier essai :


Dim li As Long, lij1 As Long, lij2 As Long, lij3 As Long
Dim vnombre As Long

lij1 = 2
lij2 = 3
lij3 = 3
Application.ScreenUpdating = False
With Sheets("fichetype")
li = .range("a5000").End(xlUp).Offset(1, 0).Row
.range("A" & li).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
skipblanks:=False, Transpose:=False
range("A2:A9").Copy
.range("A" & li + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
skipblanks:=False, Transpose:=False

End With
MsgBox ("Le nom a été transféré !")
Application.ScreenUpdating = False

If vnombre = 7 Then
MsgBox "Ce groupe est complet. Vous ne pouvez plus mettre de noms !", vbInformation
End If

End Sub


voici le fichier joint
https://www.cjoint.com/?cbmyCJC01a

merci d'avance
waea

16 réponses

Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

quelqu'un peut il me venir en aide SVP merci d'avance !
0
Messages postés
10731
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
22 janvier 2022
1 249
Bonjour,
Ou est le problème ?
De plus le fichier ne contient pas votre code ?
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Salut waea, Jean-Pierre,
Alors en effet il manque le code dans le fichier...
de plus, on dirait bie qu'il manque du code (ou des explications) :
- ".range("A" & li).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
skipblanks:=False, Transpose:=False" => tu ne copies rien avant ton premier collage (du moins pas dans le code) ???
- "If vnombre = 7 Then" => vnombre n'est pas "alimenté" dans le code que tu donnes....
qqes explications complémentaires sur ce que tu souhaites accomplir seraient aussi bien utiles pour t'aider/te conseiller...
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

https://www.cjoint.com/?ccr2u6ma8z

bonjour et merci tout d'abord
voici le fichier avec le code intégré

mon code est totalement "batard" et sans doute tout ou en partie obsolète !
ce que souhaiterais, c'est prendre n'importe quel nom au hasard et pouvoir le coller dans le groupe A modifié tout en excédant pas 7 entrées.
ceci est une simulation restreinte de ce que je voudrais faire et si je comprends ce que vous me donnerez, j'espère pouvoir ensuite l'adapter.

est-ce que ces explications vous conviennent? ou vous faut-il autre chose ?

merci encore de votre aide

waea
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Re,
bon jviens de jetter un oeil rapide, tu peux faire un truc comme ça par exemple :
Sub transfertA()

Dim nom As String
dim ligvide as Integer

nom = ActiveCell.Value
If nom = "" Then
    MsgBox "Erreur : Aucun nom sélectionné, veuillez selectionner une case non-vide", vbCritical
End If

ligvide = Range("A65536").End(xlUp).Row + 1

If ligvide > 18 Then
    MsgBox ("Le groupe est complet, le nom """ & nom & """ n'a pas pu etre inseré")
Else
    Range("A" & ligvide).Value = nom
End If


End Sub
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

https://www.cjoint.com/?cct6vo6egm

merci tout d'abord, mais le code ne donne rien de bon!!!!!
je vous transmets le fichier origine avec les bonnes cellules et la configuration d'origine pour vous aider.
bien sur je cherche de mon côté et bien sur je cale

à bientôt j'espère

waea
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Re,
bah si le code donne du bon, mais faut l'utiliser avec le fichier que tu as donné ou l'adapter (forcement si tu changes de fichier sans rien changer dans le code ça marche pas, mais ça ma petite soeur aurait pu te le dire) !
"bien sur je cherche de mon côté" => ok, dans ce cas je te laisse relire le bout de code que j'ai posté précédemment, le comprendre et l'adapter....Tu ne fais aucun effort : "le code ne donne rien de bon", pas la moindre description de ce que tu as essayé, de ce qui bloque, pas de message d'erreur si il y en a etc.....
Moi jveux bien aider (d'ailleurs jsuis là pour ça) mais à un moment faut que tu t'aides aussi; cf ton post 4 : "si je comprends ce que vous me donnerez, j'espère pouvoir ensuite l'adapter" => bah essaie déjà de comprendre, si t'as des questions pas de souci, jsuis là, mais pour l'instant je bouge plus (apparemment t'as pas compris mais "le code ne donne rien de bon", ça nous avance pas )......
En plus tu expliques toujours pas ce que tu cherches à accomplir et quand je regarde ton fichier, tu m'as pas l'air d'etre sur la bonne piste....
0
Messages postés
10731
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
22 janvier 2022
1 249
Bonjour,
J’avais préparé cette procédure à mettre dans un module de feuille :
Sub selection()
Dim sel As Byte, grAmo As Byte
sel = ActiveWindow.RangeSelection.Count
grAmo = WorksheetFunction.CountA(Range("a12:A18"))
If (7 - grAmo) >= sel Then
livi = Cells(19, 1).End(xlUp).Offset(1, 0).Row
ActiveWindow.RangeSelection.Copy Destination:=Cells(livi, 1)
Else
MsgBox "Pas de place disponible, désolé!"
End If
End Sub


Note : vous devez sélectionner les éléments désirés dans un groupe et ensuite déclencher la procédure.

Au passage, la procédure de tompols fonctionne très bien en prenant soin de l'adapter aun minimum à votre fichier. Je trouve votre réponse : mais le code ne donne rien de bon!!!!! pas très convenable !
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

Bonjour,

pardon, mais je ne comprends pas du tout cette déferlante concernant mes propos ! il n'y a de ma part aucune intention de "choquer" ! c'est une expression sans plus !
il me semble que les esprits sont quelque peu sensibles malgré toute la politesse et le respect que je met dans mes posts.

en ce qui concerne les codes, il est bien évident, mais cela à l'air de vous échapper, que chaque fois que je demande de l'aide, je fais de mon côté des recherches et les adaptations que je suis capables de faire........étant donné mon degré de compréhension.
si mes explications ne vous suffisent pas , j'en suis désolée : je vous réponds comme je peux, en passant peut-être à côté de l'essentiel..........mais ce qui est important pour les uns ne l'ai pas forcément pour les autres!
tout est question de savoir ce qui peut être important pour vous, les tuteurs.

vous mettez souvent des codes dont je ne comprends pas toutes les données, alors comment puis je adapter correctement, et vous répondre.

waea
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Salut waea,
dsl jme suis ptet un peu enervé mais tu ne poses aucune question, jsuis tout à fait pret à t'aider pour adapter mais il faut que tu dises ce que tu ne comprends pas et les messages d'erreur que tu peux avoir. Actuellement c'est plutot frustrant, tu prends le code, copies/colle ou autre (?) et apres tu dis "ça marche pas". Quand tu vas chez le docteur, tu ne dis pas "jsuis malade", tu énonces les symptomes non ? Moi, avec "ça marche pas", jpeux rien faire.....
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

Ok on efface tout et on recommence !
je vais essayer de m'appliquer ! je réessaye avec vos deux codes et je vous tiens au courant

waea
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

Bon voici des nouvelles :

concernant le code de Tompol, dès que je sélectionne une cellule avec un nom n'importe où dans le tableau du haut, une boite apparaît " ce groupe est complet, le nom "XXXX" ,n'a pas pu être inséré".
finalement, rien d'autre ne ce passe et l'opération s'arrête là.
aucun nom n'a été transféré.

concernant le code de LE Pingou,

il y a plusieurs petites choses :
j'ai déclaré la variable livi pour qu'elle soit prise en compte, et j'ai changé les références du tableau où doivent se faire le copiage
j'ai également changer la ligne de commande livi, qui marche maintenant
le code devient donc celui ci :

Dim sel As Byte, grAmo As Byte
Dim livi As Byte

sel = ActiveWindow.RangeSelection.Count
grAmo = WorksheetFunction.CountA(Range("A12:A19"))
If (7 - grAmo) >= sel Then
livi = Cells(46, 1).End(xlUp).Offset(1, 0).Row
ActiveWindow.RangeSelection.Copy Destination:=Cells(livi, 1)
Else
MsgBox "Pas de place disponible, désolé!"
End If
End Sub

MAIS,
une fois que tous les noms sont inscrits dans le groupe A, je n'arrive pas à avoir le MsgBox disant que le groupe est complet
+ le tableau du haut comporte des couleurs et je ne sais pas comment faire pour que le copiage enlève cette couleur de fond mais laisse le nom seulement
+ je ne comprends pas à quoi correspond "A12:A18" car sur mon exemple, il n'y a aucunes valeurs à cet endroit là !

comme je voudrais faire un bouton pour chaque transfert vers groupe B, vers groupe C, etc.....il fzut que je comprenne exactement ce que vous faites pour ne pas vous embêter encore davantage !
0
Messages postés
10731
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
22 janvier 2022
1 249 >
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

Bonjour,
Concerne : + je ne comprends pas à quoi correspond "A12:A18" car sur mon exemple, il n'y a aucunes valeurs à cet endroit là !
Dans le code il s’agit de « A12 :A19 » et voici votre exemple : https://www.cjoint.com/?cdoijcVKui
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Ok,
bon on va avancer sur le code donnée par Jean-Pierre (aka Le Pingou) qui permet de sélectionner plusieurs noms d'un coup :
grAmo = WorksheetFunction.CountA(Range("A12:A19")) => ici l'idée est de compter le nombre de valeurs comprises dans la plage A12:A19 (cette plage est la page cible) afin de définir combien de personnes sont déjà dans le groupe
sel = ActiveWindow.RangeSelection.Count => compte le nombre de cellules sélectionnées
du coup "If (7 - grAmo) >= sel" permet de tester qu'il reste de la pace dans le groupe....
Pour info mon code ne marchait pas sur ta nouvelle feuille à cause de :
ligvide = Range("A65536").End(xlUp).Row + 1 'detremine la ligne de la premiere cellule ou ecrire (on remonte vers le haut depuis A65536 jusqu'à la premiere cellule non-vide et on descend d'une ligne)
If ligvide > 18 Then 'si la ligne de la cellule ou ecrire est > 18 alors message d'errue (ton groupe commençait en A11 ds le 1er exemple donc 11+7 = 18, aores la ligne 18 le groupe est complet)
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

OK compris,

reste que le lorsque je rentre 7 noms dans le nouveau groupe le MsgBox ne réagit pas !
je n'ai pas l'info comme quoi le groupe est complet, comment cela se fait-il ?

en fait il s'agit pour moi d'une parade pour bloquer au cas où il y aurait trop d'entrées.

en ce qui concerne le problème de la couleur de fond des cellules copiées, que dois-je mettre et où dans le code pour que la macro la lise ?

PS : ce que je ne comprends pas, c'est pourquoi dans les codes que vous me donnez, vous sélectionner une plage autre que le plage dans laquelle doit se faire la copie. je m'explique, vous choisissez A12:A19, alors que la plage de copiage est A39:A45 , en ce qui concerne le groupe A ?

merci encore
waea
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015
>
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

je reviens,

j'ai changé le groupe et ça marche ! ( A12:A19 en A39:A45)
reste le problème du fond de cellules et mon adaptation avec d'autres boutons : j'essaye !

merci encore
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015
>
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

encore moi,

j'ai essayé d'adapter pour copier dans le groupe 2 en changeant à chaque fois ce qui était A en B, mais cela bloque !
cellule de copiage B = B39:B45
code que j'ai mis !

Dim sel As Byte, grBmo As Byte
Dim livi As Byte

sel = ActiveWindow.RangeSelection.Count
grBmo = WorksheetFunction.CountB(Range("B39:B45"))
If (7 - grBmo) >= sel Then
livi = Cells(46, 1).End(xlUp).Offset(1, 0).Row
ActiveWindow.RangeSelection.Copy Destination:=Cells(livi, 1)
Else
MsgBox "le groupe est complet "
End If
End Sub


là je bloque encore ! et comme je dois faire d'autres boutons, le film n'est pas fini :)
waea :)
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Re,
tu as oublié de chnager le numéro de colonne pour la destination et la ligne ou écrire :
livi = Cells(46, 2).End(xlUp).Offset(1, 0).Row
ActiveWindow.RangeSelection.Copy Destination:=Cells(livi, 2)
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

Bonjour,

j'ai de nouveau un petit problème avec la macro !

en fait si je veux l'adapter pour transférer dans le groupe B, cela ne fonctionne pas malgré les changements effectués.
ça bloque à ce niveau là:
grBmo = WorksheetFunction.CountB(Range("B39:B45"))

j'ai bien sur fait les modifications que vous m'avez suggéré mais c'est plus haut dans le code que cela ne passe pas

pourriez vous encore m'aider SVP
merci
waea
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Re,
le probleme est ici :
grBmo = WorksheetFunction.CountB(Range("B39:B45"))
en fait CountA est une fonction (c'est la tradution anglaise -utilisée par vba- de la formule NBVAL())
il faut donc que tu écrives :
grBmo = WorksheetFunction.CountA(Range("B39:B45"))
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

OH ! là que ce passe -t-il?
maintenant le copiage s'effectue dans les cellules de B18 à B33 età la fin j'ai la macro qui "coince" à cet endroit là !
ActiveWindow.RangeSelection.Copy Destination:=Cells(livi, 2)

décidemment je ne comprends rien!
j'avoue commencer à être découragé! malgré toute votre aide, j'ai l'impression de faire de la résistance

quelle pouasse pour moi !
waea
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

Re,

bon j'ai changé le code et ça marche.............;en partie
maintenant le problème c'est que lorsque le groupe B est complet le message m'en avertissant n'apparait pas ???

voiçi le code que j'ai changé

Dim sel As Byte, grBmo As Byte
Dim livi As Byte

sel = ActiveWindow.RangeSelection.Count
grBmo = WorksheetFunction.CountA(Range("B39:B45"))
If (7 - grBmo) >= sel Then
livi = Cells(46, 3).End(xlUp).Offset(1, 0).Row
ActiveWindow.RangeSelection.Copy Destination:=Cells(livi, 3)
Else
MsgBox "Le groupe est complet ! Vous ne pouvez plus mettre de noms "
End If
End Sub

waea
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Oh! mais qu'est-ce qu'il se passe ? (les amateurs reconnaitront):D
Bon, peux-tu stp mettre la dernière version de ton classeur sur cjoint, jregarde ça dès que j'ai 5min... ?
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

https://www.cjoint.com/?cetDwZXBPi

bonjour, voiçi le fichier !

pendant que vous y êtes, puis-je vous demander de regarder aussi ce que j'ai mis concernant le fait que lorsque je copie les données, elles sont dans le tableau recopiées avec la couleur de fond

le code que j'ai entré permet de copier dans le tableau 2 sans couleur (ce qui est bien), mais ce qui est moins bien c'est que cela enlève la couleur du tableau 1 du haut.
j'aimerais que les cellules du haut gardent leurs couleurs respectives, et qu'elles se transposent dans le tableau 2 du bas, sans couleur de fond !

voilà, voilou !

merci encore de toute l'aide ENORME, que vous m'apportez.
si je pouvais en faire autant ce serait avec plaisir, mais...............

cordialement
waea
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
bonsoir,
alors, en reprenant ton code pour le groupe B :
Sub vers_équipeB()
'
' vers_équipeB Macro
'
Dim sel As Byte, grBmo As Byte
Dim livi As Byte

Application.ScreenUpdating = False 'desactive le rafraissement d'écran

sel = ActiveWindow.RangeSelection.Count
grBmo = WorksheetFunction.CountA(Range("C39:C45")) 'TA PLAGE DE DESTINATION EST EN COLONNE C !
If (7 - grBmo) >= sel Then
    livi = Cells(47, 3).End(xlUp).Offset(1, 0).Row
    ActiveWindow.RangeSelection.Copy 'copie la plage dns le presse-papier
    Cells(livi, 3).Select 'selectionne le cellule de destination
    Selection.PasteSpecial (xlPasteValues) 'colle uniquement les valeurs contenues dans le presse-papier
Else
    MsgBox "Le groupe est complet ! Vous ne pouvez plus mettre de noms. "
End If

Application.CutCopyMode = False 'desactive la mise en surbrillance de la cellule copiée

Application.ScreenUpdating = False 'permet le rafraichissement d'écran

End Sub

Ce que j'ai modifié est en italique avec commentaires....

0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

bonjour,

ouf ! tout fonctionne parfaitement
j'ai adapté avec d'autres boutons pour copier dans les autres groupes ...............;;et j'y suis arrivé !

en tout cas MERCI INFINIMENT POUR VOTRE AIDE compte tenu de mes erreurs d'explications !
j'espère que vous ne m'en tenez pas rigueur et que j'aurais le plaisir de re travailler avec vous

cordialement
waea
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Bonjour waea,
content que tu y sois arrivé. Bon, jme suis ptet un peu emporté par moments mais avec un peu d'efforts des 2 cotés, on y est arrivé, c'est le principal....au plaisir d'échanger à nouveau :)
Tom
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

oups

de nouveau un petit problème d'adaptation:

que dois-je faire en ce qui concerne le copiage dans les tableaux E,F,G,H

E étant aussi dans la colonne A, j'avoue que je cale............;;encore

encore un petit effort TOMPols et pour le reste il n'y à aucun problème !
je ne suis pas susceptible, j'avais ma part !

vous comprenez mon pb ?

merci
waea
0
Messages postés
1219
Date d'inscription
jeudi 29 juillet 2004
Statut
Contributeur
Dernière intervention
25 novembre 2013
458
Re,
alors :
- grBmo = WorksheetFunction.CountA(Range("C39:C45")) => ici tu mets ta plage de destination (sert à compter le nombre de valeur et donc de gens déjà inscrits)

- livi = Cells(47, 3).End(xlUp).Offset(1, 0).Row => ici tu determine la ligne sur laquelle écrire, tu peux reproduire ce code en te plaçant sur la cellule concerné (Cells 47,3 = C47) et en faisant "CTRL + fleche vers le haut" (correspond à Cells(47, 3).End(xlUp)) puis en redescendant d'une cellule (instruction Offset(1, 0)). exemple pour ton groupe E : livi = Cells(59, 1).End(xlUp).Offset(1, 0).Row

normalement tu devrais y arriver avec ces explications...tiens moi au courant....
0
Messages postés
42
Date d'inscription
lundi 18 janvier 2010
Statut
Membre
Dernière intervention
31 août 2015

Re,

bon alors, avec cette explication et quelques nouvelles adaptations de mon cru, FINISH !

tout fonctionne parfaitement

merci encore et à bientôt sur le site..............pour une autre aventure !

cordialement
0