XL 2013 Insertion automatique d'une ligne dans un tableau

[Ananas94]

Bonjour,

J'ai un tableau de bord avec des noms de groupes, qui rassemblent des équipes. Je souhaite créer une macro qui ajoute quelqu'un , dans la bonne ligne, selon le groupe sélectionné.
Ainsi, je souhaite insérer automatiquement une ligne dans un tableau, dans le groupe choisi.
Voici ma macro (je vous joins un fichier teste également).

Sub insertion_ligne()
'Procédure pour insérer une ligne dans le tableau une fois qu'un nom de groupe a été trouvé'

Dim Cellule As Range
cat_groupe = InputBox("A quel groupe souhaitez-vous ajouter un membre ?")

'1-rechercher le nom du groupe dans la colonne Groupe, donc après la cellule B6 (40 est arbitraire)'
With Worksheets("test").ListObjects("Tableau_general")
Set Cellule = .ListColumns("Groupe").Range.Find(Range(cat_groupe), SearchDirection:=xlPrevious)
If Not Cellule Is Nothing Then
'recherche dans tableau de suivi de la dernière ligne correspondant à la catégorie produit et type produit sélectionné
Set cellule1 = Cellule
Do
i = cell.Row - .HeaderRowRange.Row 'numéro de ligne du tableau
'inserer une ligne en-dessous la dernière cellule de la catégorie de groupe concernée'
Set Cellule = .ListColumns("Groupe").Range.FindPrevious(Cellule)
'On intègre le nom du groupe dans la cellule'
Cellule.Value = Groupe
Loop Until cell.Address = cell1.Address 'On continue l'action tant que l'on rencontre une cellule de la catégorie du groupe pour que la cellule soit joutée en-dessous de la dernière'

Range(Cellule).EntireRow.Insert xlShiftDown
i = i + 1
.ListRows.Add i
.ListColumns("Groupe").DataBodyRange.Rows(i) = Range("MDB")


End If
End With

End Sub


Je vous remercie vivement,

Anna

 

[Ananas94]

Mon code ne fonctionne pas et bloque à la ligne Set Cellule = .ListColumns("Groupe").Range.Find(Range(cat_groupe), SearchDirection:=xlPrevious) et j'obtiens l'erruer "la méthode de l'objet global a échoué". Auriez-vous une idée ? merci

NB: ne pas prendez en compte la phrase ; "donc après la cellule B6 (40 est arbitraire) " c'est une erreur
merci

 

[Staple1600]

Bonjour le fil, Ananas94

•>Ananas94
Ca tombe bien, récemmentt j'ai taté du ListObject
Regarde ici

https://www.excel-downloads.com/thr...jet-listrows-a-echoue.20042791/#post-20309256

(tu trouveras de quoi t'inspirer dans toutes les réponses)

 

[Ananas94]

Merci beaucoup pour le lien, que je viens de lire attentivement. Néanmoins le "battle" m'a plus embrouillée qu'autre chose : pourquoi compte-t-on les cellules du tableau (avec LG = Liste_groupe.DataBodyRange.Rows.Count) ?

Je ne comprenenais pas ce qui n'allait pas dans mon code en fait. Je viens de le modifier mais j'ai l'impression d'ajouter des bouts de code qui ne m'appartiennent pas et pour tout vous dire ça ne fonctionne pas non plus :




Sub insertion_ligne()
'Procédure pour insérer une ligne dans le tableau une fois qu'un nom de groupe a été trouvé'

Dim Cellule As Range
Dim Liste_groupes As ListObject, LG
cat_groupe = InputBox("A quel groupe souhaitez-vous ajouter un membre ?")

'1-rechercher le nom du groupe dans la colonne Groupe'
Set Liste_groupes = ThisWorkbook.Sheets("test").ListObjects("Tableau_general").ListColumns("Groupe").Range
With Liste_groupes
LG = Liste_groupe.DataBodyRange.Rows.Count 'On compte les cellules du tableau"
If Not Cellule Is Nothing Then
'recherche dans tableau de suivi de la dernière ligne correspondant à la catégorie produit et type produit sélectionné
Set cellule1 = Cellule
Do
i = cell.Row - .HeaderRowRange.Row 'numéro de ligne du tableau
'inserer une ligne en-dessous la dernière cellule de la catégorie de groupe concernée'
Set Cellule = .ListColumns("Groupe").Range.FindPrevious(Cellule)
'On intègre le nom du groupe dans la cellule'
Cellule.Value = Groupe
Loop Until cell.Address = cell1.Address 'On continue l'action tant que l'on rencontre une cellule de la catégorie du groupe pour que la cellule soit joutée en-dessous de la dernière'

Range(Cellule).EntireRow.Insert xlShiftDown
i = i + 1
.ListRows.Add i
.ListColumns("Groupe").DataBodyRange.Rows(i) = Range("MDB")


End If
End With

End Sub



J'ai cette fois-ci une incompatibilité de type ...
Je vous joins le fichier modifié, ce sera peut-être plus parlant ...

Je vous remercie par avance et reste à votre écoute,
Excellente journée

Anna

 

[Staple1600]

Re

Moi, j'en étais là de mes tests
Qu'en penses-tu?

Sub insert_B()
Dim LO As ListObject
Set LO = Worksheets("test").ListObjects("Tableau_general")
cat_groupe = InputBox("A quel groupe souhaitez-vous ajouter un membre ?")
LO.ListRows.Add.Range = Array(cat_groupe, "", "", "", "")
LO.Sort.Apply
End Sub

 

[Ananas94]

Bonjour !
Merci beaucoup pour votre réponse ! C'est presque cela, sauf que je souhaite que la ligne s'ajoute SOUS la dernière case comportant la même catégorie de groupe. Exemple : Je tape comme nom de groupe "MDB". Je souhaite alors que la ligne ajoutée s'insère sous le dernier membre du groupe "MDB" (et non tout à la fin du tableau).
C'est pour cette raison que j'avais ajouté dans mon code précédent une fonction de "recherche" grâce à la fonction Find : il faut que l'ordinateur recherche d'abord quelles sont les cellules qui concernent déjà le groupe en question.

Je propose donc :

Sub insert_B()
Dim LO As ListObject
Dim cellAjout As Range

Set LO = Worksheets("test").ListObjects("Tableau_general")
cat_groupe = InputBox("A quel groupe souhaitez-vous ajouter un membre ?")
cellAjout = LO.ListRows.Find(cat_groupe)
LO.ListRows.Add.Range(cellAjout) = Array(cat_groupe, "", "", "", "")
LO.Sort.Apply
End Sub

Sauf que j'obtiens l'erreur "Propriété ou méthode non gérée par cet objet" en sélectionnant la ligne : "cellAjout = LO.ListRows.Find(cat_groupe)"
Je ne comprends pas où est l'erreur , auriez-vous une idée ?
Merci

Anna

 

[Staple1600]

Bonjour le fil, Anna

•>Anna
Bah, moi, je me compliquais pas la vie
(en triant le tableau) avec : LO.Sort.Apply
Ce qui fait qu'en théorie, une fois le tri appliqué, le dernier groupe ajouté est bien à la fin, non ?)

 

[Staple1600]

Re

J'ai modifié le code pour le tri

Sub insert_C()
Dim LO As ListObject
Set LO = Worksheets("test").ListObjects("Tableau_general")
cat_groupe = InputBox("A quel groupe souhaitez-vous ajouter un membre ?", "Test", "GROUPE3")
LO.ListRows.Add(AlwaysInsert:=True).Range(1, 1) = cat_groupe
LO.DataBodyRange.Sort Key1:=Range("Tableau_general[GROUPE]"), Order1:=xlAscending
End Sub

NB: Fais le test sur un classeur vierge (où il y aura une feuille nommée: test), lance cette macro pour créer le tableau.
Puis pour tester, lance la macro: insert_C

Sub CréerTableau()
[A1:E1] = [{"GROUPE","ITEM2","ITEM3","ITEM4","ITEM5"}]
Range("B2:E10").FormulaR1C1 = "=ADDRESS(ROW(),COLUMN(),4)"
[A2:A4] = "GROUPE1": [A5:A7] = "GROUPE3": [A8:A10] = "GROUPE7"
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E$10"), , xlYes).Name = "Tableau_general"
ActiveSheet.ListObjects("Tableau_general").DataBodyRange.Rows(6).Font.Color = vbRed
End Sub

Cela fonctionne, non?

 

[Ananas94]

Bonjour Staple 1600,

Je vous remercie vivement pour votre réponse. Je viens de tester et une erreur concernant la ligne : LO.DataBodyRange.Sort Key1:=Range("Tableau_general[GROUPE]"), Order1:=xlAscending est :"La méthode Range de l'objet Global a échoué"..

Par ailleurs, on m'a demandé tout à l'heure d'effectuer cette insertion de ligne via un formulaire. Mais cela ne change pas grand chose en fait. Je viens de le créer. J'insère votre code au moment de l'insertion de la ligne (que j'ai un peu modifié).
Je pense qu'il y a des erreurs car lorsque je teste, j'obtiens le message suivant : "Objet spécifié introuvable". On me désigne la ligne userform.show , je ne comprends pourtant pas où est le problème ...

Serait-il possible pour vous de regarder ce que que j'ai codé ?
Je vous remercie vivement,
Anna

 

[Staple1600]

Re

Anna
L'important quand on teste, c'est de lire les réponses de A à Z
Je ne suis pas sur que ce fut le cas pour le message#8
Me trompe-je ?

 

[Ananas94]

Il me semble qu'il ne faut pas renommer le Userform. Je viens de le créer à nouveau et de l'appeler, mais ça ne fonctionne toujours pas, avec le même message d'erreur ...

 

[Staple1600]

Re

•>Anna
Qu'est-ce que je disais...
Tu n'as pas répondu à ma question du message#10
Keep cool, on a tout le temps
Donc merci de répondre à ma question, palsambleu!
(ou de faire complètement le test décris dans le message#8)

 

[Ananas94]

Si, je vous assure que j'ai testé les macros que vous m'avez envoyé, on peut même voir le tableau créé dans l'onglet "cible".
J'ai ensuite supprimé les modules pour ne pas embrouiller c'est tout.

Je teste à nouveau si vous voulez

 

[Staple1600]

Re

Pris d'un doute, je vais donc moi-même refaire le test de A à Z
(même si mon café doit ramollir et ma biscotte refroidir ! )

 

[Staple1600]

Re,

•>Anna
Voila, test refait avec succès.
Pas de message d'erreur!
Donc relire attentivement le message#8 à partir de :

NB: Fais le test...

PS: Ouf, l'honneur est sauf (ma biscotte toujours goûteuse et mon café encore fumant)