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

[Ananas94]

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 :

'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 :

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 :

Et lorsque je clique sur débogage :

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

 

[Staple1600]

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)

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

 

[Ananas94]

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 :

"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

 

[Staple1600]

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]

Re

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

Et le débogage :

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

 

[jmfmarques]

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]

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]

Re

•>Anna
Pourquoi rajouter (donc alourdir) ce que j'ai supprimé dans le message#2
Vois ci-dessous ce petit test

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]

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

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 :

Avec le débogage (en gras dans le code ci-dessus) :

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

 

[Staple1600]

Bonjour le fil, Anna

•>Anna
Pourquoi faire compliqué quand on peut faire simple?

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]

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 :

Et lors du débogage :

ç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

 

[Staple1600]

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 ?

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]

Re

J'ai allégé encore un peu le code
(en bonus, le petit souci précédemment évoqué n'en est plus un)

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

 

[Ananas94]

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]

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