Résolu XL 2013 Couper-coller une ligne d'un tableau pour coller dans un autre tableau

Ananas94

XLDnaute Junior
Bonjour !

Je souhaite à l'aide d'une macro, supprimer un outil d'un tableau; c'est à dire que l'outil passe du tableau de l'onglet "Outils_utilises" à l'onglet "Outils_HA". J'ai codé quelque chose, avec un autre userform cette fois (userForm2).

Je rencontre plusieurs problème : tout d'abord je souhaite que l'utilisateur choisisse son outil dans la liste des outils qui sont actuellement dans le tableau "Outils_utilisés". néanmoins, cette liste doit être dynamique car des outils sont susceptibles d'avoir disparus/ été ajoutés, etc.. En fait, j'aimerais lister la colonne "noms" du tableau, mais mon code ne fonctionne pas :

VB:
'Pour le formulaire
Private Sub UserForm_Initialize()

    Dim LO1 As ListObject
    Dim LO2 As ListObject
   Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Dim j As Integer
    Dim nbOutils As Integer
    
    Set Ws1 = Sheets("Outils_utilises")
    Set LO1 = Ws1.ListObjects("Tab_outils_utilises")
    Set Ws2 = Sheets("Outils_HA")
    Set LO2 = Ws2.ListObjects("Tab_outils_HA")
        
    'Nom de l'outil'
    ComboBox1.ColumnCount = 1
    ComboBox1.List() = LO1.ListColumns("Nom")[B] 'Affichage de la colonne "Noms" [/B]
    
    'Date de mise hors application  :'
    Me.Controls("TextBox3").Visible = True
J'ai tenté beaucoup de codes, notamment en code java (c'est parti trèèèès loin) ; sans succès !

Ensuite, une fois que la personne a sélectionné le nom de son outil, l'ordinateur doit chercher le nom de cet outil dans le tableau et couper-coller les valeurs du tableau correspondantes. J'ai sectionné cette grosse partie en plusieurs étapes que voici :

Code:
Private Sub CommandButton1_Click() 'Pour la mise hors application d'un outil


    Dim confirmation
    Dim i As Integer
    Dim LO1 As ListObject
    Dim LO2 As ListObject

    Set Ws1 = Sheets("Outils_utilises")
    Set LO1 = Ws1.ListObjects("Tab_outils_utilises")
    Set Ws2 = Sheets("Outils_HA")
    Set LO2 = Ws2.ListObjects("Tab_outils_HA")

 [U]'Etape 1 - L'ordinateur cherche l'outil dans la liste des outils[/U]

'[U]Etape 2 - Insertion d'une ligne à la fin du tableau "Tab_outils_HA :"[/U]
    Insertion = LO2.ListRows.Add(AlwaysInsert:=True)
   [U] 'Etape 3 - Couper-coller des cellules du tableau "tab_outils_utilises" qui se trouvent en colonnes 2 à 7 :'[/U]
    Ajout1 = LO1.ListRows(nom_outil).Cut.Range(i, 2 / 7)
   [U] 'Etape 4 :Collage de ces cellules dans la dernière ligne , dans les cellules 2 à 7 du tableau "Tab_outils_HA":'[/U]
    LO1.ListRows.Paste LO2.ListRows.Range(i, 2 / 7)
   [U] 'Etape 5 - Copie des cellules du tableau "tab_outils_utilises" qui se trouvent en colonnes 8 à 25 :'[/U]
    Ajout2 = LO1.ListRows(nom_outil).Cut.Range(i, 8 / 25)
   [U] 'Etape 6 - Collage de ces cellules dans la dernière ligne , dans les cellules 9 à 26 du tableau "Tab_outils_HA" :'[/U]
    LO1.ListRows.Paste LO2.ListRows.Range(i, 9 / 26)
    
   [I] 'Message de confirmation'[/I]
    confirmation = MsgBox(Prompt:="Outil inséré avec succès !", Buttons:=vbOKOnly, Title:="Ajout d'un outil réussi")
        
    Me.Hide
    Unload Me
    
End Sub
Lorsque je teste mon code, j'obtiens un message d'erreur :

1585562466931.png

Et lorsque je clique sur débogage :

1585562572566.png

Le problème viendrait donc de la toute première étape, lorsque je souhaite afficher la liste (dynamique) des outils listés dans la colonne "Noms" du tableau. Je pense que mon code :

ComboBox1.ColumnCount = 1
ComboBox1.List() = LO1.ListColumns("Nom")

Est faux. Mais je ne vois pas comment l'améliorer.

Auriez-vous une petite idée?

Merci :)
Anna
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonjour le fil, Anna

•>Anna
Le problème vient de l'inattention ;)
Je te laisse trouver quelle erreur j'ai corrigé
(je ne parle pas du remplissage du Combobox)
;)
VB:
'Pour le formulaire
Private Sub UserForm_Initialize()
Dim LO1 As ListObject, LO2 As ListObject
Set LO1 = Sheets("Outils_utilises").ListObjects("Tab_outils_utilises")
Set LO2 = Sheets("Outils_HA").ListObjects("Tab_outils_HA")
'Nom de l'outil'
With ComboBox1
    .ColumnCount = 1
    .List = LO1.ListColumns("Nom").DataBodyRange.Value
End With
'On liste tous les noms des outils dans le tableau Tab_outils_utilises -> Attention ils peuvent varier, il faut que cette liste soit dynamique !
'Date de mise hors application  :'
Me.Controls("TextBox2").Visible = True
End Sub
PS:
J'ai codé quelque chose
Certains ici t'ont un peu aidé, non ?
:rolleyes:
 

Ananas94

XLDnaute Junior
Bonjour mon cher Staple1600 (pourquoi ce nom d'ailleurs ?!),

En effet, c'est vraiment grâce à vous que je suis arrivée là. J'ai dit que "j'ai codé quelque chose" parce que j'ai créé une nouvelle discussion (sous vos ordres). Mais je le rappelle ici : (quasiment) tout ce code ici existe grâce à Staple1600. Encore merci.

J'ai enlevé en effet l'inattention: Textbox2 au lieu de TextBox3. Ainsi, ça fonctionne ! Merci beaucoup (encore une fois !) j'ai beaucoup modifié mon code pour la suite (toute seule cette fois :)!!)

Néanmoins, un autre problème est engendré par cette suppression d'outil : lorsque je clique sur "Supprimer cet outil" j'obtiens un message d'erreur :

1585666713669.png

"Erreur de compilation : Objet requis". J'ai pourtant bien initialisé la variable "nom_outil" qui est l'outil que je cherche !!
Auriez-vous une idée ? :)

Merci merci merci beaucoup

Anna
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Re

Dim nom_outil As Range
devrait être ce qu'on voit sur ta copie d'écran ;)

Quand à mon pseudo, G..gle est ton ami ;)
 

Ananas94

XLDnaute Junior
Re

C'est vrai, ça avance un peu ;... et maintenant une autre erreur (décidément) :

1585671782501.png


Et le débogage :
1585671820135.png

Là, j'avoue que je suis complètement bloquée, car :
-le nombre d'arguments est correct puisqu'il y a une seule cellule à chaque fois(la cellule active, nom_outil)
-l'affectation de propriété est sûrement fausse, mais je ne vois pas en quoi c'est faux de dire que la cellule active est issue de la fonction Find, donc quand l'ordinateur a trouvé le nom de l'outil.

Auriez-vous une idée, cher destinataire qui porte le nom d'une imprimante (ahahahah)? :)
merci merci
Anna
 

Fichiers joints

jmfmarques

XLDnaute Accro
Bonjour
Même Géo Trouvetout ne comprend rien si on lui demande de trouver sans lui dire ce qu'il y a à trouver.
Analyse donc le sens de l'instruction surlignée.
 

Staple1600

XLDnaute Barbatruc
Bonsoir jmfmarques

Géo Trouvetout ou Géo Trouvetout?
Car seul Gyro Gearloose est Option Explicit ;)
OK je sors

•>Anna
C'est pas l'imprimante, mais la référence de la boite d'agrafe qui fut à l'origine de mon pseudo
 

Staple1600

XLDnaute Barbatruc
Re

•>Anna
Pourquoi rajouter (donc alourdir) ce que j'ai supprimé dans le message#2 :rolleyes:
Vois ci-dessous ce petit test
VB:
Private Sub CommandButton1_Click() 'Pour la mise hors application d'un outil
    Dim confirmation, Insertion, Ajout1, Ajout2
    Dim i As Integer, X&, LO1 As ListObject, LO2 As ListObject, nom_outil As Range
    Dim dCell, Partie1_coupe, Partie1_colle, Partie2_coupe, Partie2_colle
    Set LO1 = Sheets("Outils_utilises").ListObjects("Tab_outils_utilises")
    Set LO2 = Sheets("Outils_HA").ListObjects("Tab_outils_HA")
    'Etape 1 - Insertion d'une ligne à la fin du tableau "Tab_outils_HA" :
    With LO2
        Set dCell = .ListRows.Add(AlwaysInsert:=True)
    End With
    'Etape 2 - L'ordinateur cherche l'outil dans la liste des outils du tableau "Tab_Outils_utilises" :
    X = Application.Match(ComboBox1.Value, LO1.ListColumns("Nom").DataBodyRange, 0)
   Set nom_outil = LO1.Range(X + 1, 2)
   MsgBox nom_outil.Address ' pour test
   MsgBox nom_outil.Value 'pour test
   '/////////////////////
'    With LO1
'           ' Set nom_outil = .ListColumns("Nom").Range.Find(SearchDirection:=xlNext)
'
'            'Etape 3 - Couper-coller des cellules du tableau "tab_outils_utilises" qui se trouvent en colonnes 2 à 7 :'
'            'Set Partie1_coupe = LO1.ListRows(nom_outil).Cut.Range(i, 2 / 7)
'    End With
' suite de l'ancien code
End Sub
 

Ananas94

XLDnaute Junior
Bonjour à tous !
Merci (encore) beaucoup pour vos remarques pertinentes !Il est vrai que lorsque l'on voit mon ancien code, je me rends compte que je n'avais pas dit à l'ordinateur que la valeur que je cherchais venait de la combobox, donc forcément, il ne risquait pas de la trouver!
Enfin bref, une fois de plus, ce code parfait fonctionne, grâce à vous :) J'ai ensuite entièrement repensé la suite de mon code pour effectuer ces actions :

1-Couper une première partie du tableau de l'onglet "Outils_utilises" (LO1)
2-Coller cette partie dans la première moitié du tableau de l'onglet "Outils_HA" (LO2)
3-Faire de même avec la partie 2 de LO1, à coller dans la seconde moitié de LO2
Voici mon code (En gras, la ligne qui pose problème) :

VB:
Private Sub CommandButton1_Click() 'Pour la mise hors application d'un outil

    Dim confirmation, Insertion, Ajout1, Ajout2
    Dim i As Integer, X&, LO1 As ListObject, LO2 As ListObject, nom_outil As Range
    Dim NewLine, Partie1_D, Partie2_D, Partie1_A, Partie2_A, Partie1_cut, Partie2_cut, Partie1_paste, Partie2_paste
    Set LO1 = Sheets("Outils_utilises").ListObjects("Tab_outils_utilises")
    Set LO2 = Sheets("Outils_HA").ListObjects("Tab_outils_HA")
      
    'Etape 1 - L'ordinateur cherche l'outil dans la liste des outils du tableau "Tab_Outils_utilises" :
    X = Application.Match(ComboBox1.Value, LO1.ListColumns("Nom").DataBodyRange, 0) 'Champ à 0 pour trouver une valeur exactement égale à celle que l'on recherche
    Set nom_outil = LO1.Range(X + 1, 2)
    
   'Etape 2 - Définition des parties dans chaque tableau
    With LO1
        [B]Set Partie1_D = .Range("B" & (X + 1)).Resize(2, 7)[/B] 'Partie 1 : colonnes 2 à 7
        Set Partie2_D = .Range("J" & (X + 1)).Resize(8, 25) 'Partie 2 : colonnes 8 à 25
   End With
    
    With LO2
        Set NewLine = .ListRows.Add(AlwaysInsert:=True) 'Etape 3 - Insertion d'une ligne à la fin du tableau "Tab_outils_HA"
        Set Partie1_A = .Range("B" & NewLine, "H" & NewLine)
        Set Partie2_A = .Range("J" & NewLine, "AA" & NewLine)
    End With
        
    'Etape 3 - Couper-coller des cellules du tableau "Tab_outils_utilises" dans "Tab_outils_HA" :
    Set Partie1_cut = Partie1_D.Cut
    Set Partie1_paste = Partie1_A.Paste
    Set Partie2_cut = Partie2_D.Cut
    Set Partie2_paste = Partie2_A.Paste

    'Message de confirmation'
    confirmation = MsgBox(Prompt:="Outil nommé : " & nom_outil.Value & "mis hors application.", Buttons:=vbOKOnly, Title:="Outil mis hors application")

    Me.Hide
    Unload Me
    
End Sub
Lorsque je teste mon code, j'ai encore un message d'erreur ! Le voici :

1585725301569.png
Avec le débogage (en gras dans le code ci-dessus) :
1585725359965.png

L'erreur vient donc de la procédure Resize ..? En fait, ici :
Set Partie1_D = .Range("B" & (X + 1)).Resize(2, 7)
L'erreur est donc lorsque je définis la partie 1 à copier (D comme départ, A comme arrivée).
Je ne comprends pas en quoi cette ligne est fausse : je dis bien ici que la partie 1 est dans LO1, à partir de la cellule de colonne B et de ligne celle où se situe l'outil trouvé (donc ligne X+1, exprimée tout à l'heure par Staple1600, ces chères agraphes ndlr) . je dis bien aussi que je souhaite juste les colonnes 2 à 7.... Où est le problème ? :(

Merci par avance
Excellente journée,
Anna
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonjour le fil, Anna

•>Anna
Pourquoi faire compliqué quand on peut faire simple?
VB:
Private Sub CommandButton1_Click() 'Pour la mise hors application d'un outil
Dim confirmation, X&, LO1 As ListObject, LO2 As ListObject, nom_outil As Range
Set LO1 = Sheets("Outils_utilises").ListObjects("Tab_outils_utilises")
Set LO2 = Sheets("Outils_HA").ListObjects("Tab_outils_HA")
'Etape 1 - L'ordinateur cherche l'outil dans la liste des outils du tableau "Tab_Outils_utilises" :
X = Application.Match(ComboBox1.Value, LO1.ListColumns("Nom").DataBodyRange, 0) 'Champ à 0 pour trouver une valeur exactement égale à celle que l'on recherche
Set nom_outil = LO1.Range(X + 1, 2)
MsgBox nom_outil.Offset(0, -1).Resize(, 25).Address ' pour test
nom_outil.Offset(0, -1).Resize(, 25).Cut LO2.ListRows.Add.Range(1, 1)
'Message de confirmation'
Me.Hide: Unload Me
End Sub
NB: Maintenant, je te laisse trouver le petit souci qui vient d’apparaître sur LO1 ;)
 

Ananas94

XLDnaute Junior
Bonjour,

Merci beaucoup pour ce code, par contre j'ai l'impression que ça m'a bloqué la macro! En effet, un message :"l'indice n'appartient pas à la sélection" apparaît alors que j'ai juste remplacé votre code:

Le message suivant s'affiche :
1585749459962.png

Et lors du débogage :
1585749506589.png

ça doit sûrement être un truc débile, mais je ne trouve vraiment pas :(

Par ailleurs, je n'ai plus le problème de scinder en deux le collage (après discussion avec la hiérarchie ndlr) ; finalement la date de mise hors application sera décalée tout à droite.
Ainsi, j'ai juste à couper-coller directement la ligne, mais quand je vois le code , en fait c'est ce qui a été fait je crois, donc il n'y a rien à modifier.
merci
Anna
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Re

Et quid du petit souci?
Tu as trouvé de quoi je parlais ? ;)

Mon code commence par
Private Sub CommandButton1_Click()

Et sur ta copie d'écran, que lit-on ? :rolleyes:

Si ta hiérarchie avait deux sous de jugeote, les colonnes seraient agencées dans le même ordre dans LO1 et LO2 ;)
PS: Si ta hiérarchie lit ses lignes, je ne doute pas qu'elle a le sens de l'humour ;)
 

Staple1600

XLDnaute Barbatruc
Re

J'ai allégé encore un peu le code ;)
(en bonus, le petit souci précédemment évoqué n'en est plus un)
VB:
Private Sub CommandButton1_Click() 'Pour la mise hors application d'un outil
Dim confirmation, X&, LO1 As ListObject, LO2 As ListObject
Application.ScreenUpdating = False
Set LO1 = Sheets("Outils_utilises").ListObjects("Tab_outils_utilises")
Set LO2 = Sheets("Outils_HA").ListObjects("Tab_outils_HA")
With LO1
    X = Application.Match(ComboBox1, .ListColumns("Nom").DataBodyRange, 0)
    .Range(X + 1, 0).Resize(, 26).Cut LO2.ListRows.Add.Range(1, 0)
    .ListColumns(2).DataBodyRange.SpecialCells(4).Rows.Delete
End With
'Message de confirmation'
Me.Hide
Unload Me
End Sub
 
Ce message a été identifié comme étant une solution!

Ananas94

XLDnaute Junior
Bonjour,

Merci beaucoup pour cette aide mais je ne comprends toujours pas, en effet, l'erreur est pointée sur le module suppression_outil alors que je n'y touche jamais ! ceci n'a rien à voir avec le formulaire en plus (j'avais bien remarqué que l'en-tête de votre code était CommandButton1_Click(), et je l'avais placé au bon endroit, j'avais même joint mon fichier)
je ne comprends pas pourquoi cette erreur apparaît lors du débogage, ça n'a aucun sens
 

Ananas94

XLDnaute Junior
J'ai un peu modifié le code mais rien n'y fait, j'ai toujours l'erreur :(
Néanmoins, je viens de lire sur une autre conversation de forum (https://www.developpez.net/forums/d...-appartient-selection-associee-userform-show/)
que je ne suis pas la seule à avoir cette erreur-là ! Ainsi, l'erreur est pointée dans le module de suppression mais l'erreur ne vient pas de là!! Ceci provient sûrement du fait que ce soit dès l'initialisation qu'il y a un problème ; donc dans le code du UserForm (ce qui est nettement plus probable).
J'ai toujours l'erreur, mais j'apprends petit à petit :)
Vous trouverez en pièce jointe mon code un peu modifié (mais toujours visiblement faux)
Anna
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Re

Quand il y a une erreur, pour la trouver, on peut (puisque confiné) prendre le temps de faire ceci.
Tu mets en commentaires tout le code VBA de tes userforms
(avec le bouton "Commenter bloc" de la barre d'outils Edition de VBE
>voir sur le net pour le How To et détails...

Une fois, cela fait, tu décommentes les procédures une à une en affichant l'Userform entre chaque "décommentement".
Jusqu'à ce que l'erreur survienne

Je te laisse tester la chose ;)

PS: Parce que là, je commence à avoir N etat_des_lieux*.xlsm sur mon disque dur ;)
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, Anna

•>Anna
Par acquis de conscience, et parce que je subodorais la chose, j'ai quand même ouvert ton classeur...
Et Bingo !!!
Le problème (qui va devenir) récurrent, si tu n'y prends pas garde, c'est...
Attendez la suite.... (oui je pararaphrase Barney S. ;))

.... c'est l'inattention :rolleyes:

Anna: Rappelles-moi, stp, le nom de l'entête de la colonne B du tableau LO1 ?

Et relis celui qu'y se trouve dans le code de l'userform2 quand tu fais référence à cette colonne ?
 

Ananas94

XLDnaute Junior
Bonjour Staple1600 (ahahah je ne m'en remets pas!)!!
Merci merci MERCI ! Je ne sais pas comment je me débrouille, mais parfois je me demande où je suis ! Je pense que c'est à force d'avoir la tête dans le guidon .. En tout cas merci, vous êtes trop fort :)
Anna
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas