macro copie de données sélectives dans tablea Résolu

Question

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

waea · Answer

quelqu'un peut il me venir en aide SVP merci d'avance !

Le Pingou · Answer

Bonjour,
Ou est le problème ? 
De plus le fichier  ne contient pas votre code ?

tompols · Answer

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...

waea · Answer

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

tompols · Answer

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

tompols · Answer

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....

Le Pingou · Answer

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 !

tompols · Answer

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.....

tompols · Answer

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)

tompols · Answer

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)

tompols · Answer

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"))

waea · Answer

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

tompols · Answer

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... ?

tompols · Answer

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....

tompols · Answer

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

tompols · Answer

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....

Macro copie de données sélectives dans tablea

16 réponses

Discussions similaires

Newsletters