Créer des macros pour chaque lignes

Le 18/05/2021 à 20:07

Bonjour à tous les pros du VBA,

Je m'appelle Joe et, jusqu'à aujourd'hui, j'ai toujours trouvé mon bonheur sans avoir à créer de compte ici, mais là je sèche un peu car ma demande est, peut-être, un peu spéciale !

Je m'explique, je suis sous excel 2019 et j'ai créé un classeur avec 2 feuilles de calcul : sur la première feuille se trouvent 7 colonnes (Référence, gencod, libellé....), et la 2ème feuille avec seulement 4 colonne, que l'on peu voir également sur la feuille 1.

L'idée est de créer une macro en bout de chaque ligne pour envoyer de contenu de la ligne sélectionnée en cliquant sur le bouton de macro vers la feuille 2, mais seulement le contenu de 4 colonnes sur les 7 présentes ! J'ai réussi plus ou moins à le faire pour la 1ère ligne, mais dois-je créer la même macro qui s'applique à chaque lignes ou existe t-il un espèce de "copier/coller" pour une macro qui changerait automatiquement les données de cette macro par rapport à la ligne en question ? C'est peut-être compliqué à comprendre, je ne suis plus très sûr moi-même de comprendre !

Aussi, en cliquant sur le bouton de macro sur la feuille 1, le contenu des 4 colonnes (choisies pour la feuille 2) de la ligne devront être envoyer sur la feuille 2 les unes sous les autres, sans que la 1ère ligne de la feuille 2 soit effacée et remplacée par la sélection d'une nouvelle ligne sur la feuille 1! Pfff J'ai mal à la tête......

Exemple : 1 - je clique sur la macro de la ligne 1 de la feuille 1, son contenu est envoyé su la ligne 1 de la feuille 2

2 - je clique sur la macro de la ligne 2 de la feuille 1, son contenu devra être envoyé sur la ligne 2 de la feuille 2 (càd sur la ligne libre suivante, donc ligne 2)

3 - je clique sur la macro de la ligne 3 de la feuille 1, son contenu devra être envoyé sur la ligne 3 de la feuille 2 (càd sur la ligne libre suivante, donc ligne 3)

.......etc

Sachant que la feuille 2 ne contiendra pas plus de 5 lignes, donc 5 références.

Je vous joins mon fichier test car j'ai du mal à m'expliquer sur quelque chose que je ne maitrise malheureusement pas !

18essai-macro.xlsm (25.38 Ko)
Le 18/05/2021 à 21:09

Hello,

une proposition, sur un seul bouton :

Sub Deplacer()

Const Name_F_Copy As String = "Feuil1"
Const Name_F_Paste As String = "Feuil2"

Dim Numero_Ligne As Integer
Dim rg_Copy As Range
Dim rg_Paste As Range
Dim F_Copy As Worksheet
Dim F_Paste As Worksheet
Dim Last_Row_Paste As Long

Numero_Ligne = Application.InputBox("Entrer le numéro de la ligne à copier", Type:=1)

If Numero_Ligne > 0 Then
    Set F_Copy = Sheets(Name_F_Copy)
    Set F_Paste = Sheets(Name_F_Paste)
    Set rg_Copy = F_Copy.Range("A" & Numero_Ligne & ":C" & Numero_Ligne)
    Last_Row_Paste = F_Paste.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set rg_Paste = F_Paste.Range("A" & Last_Row_Paste & ":C" & Last_Row_Paste)
    rg_Paste.Value2 = rg_Copy.Value2
    Set rg_Copy = F_Copy.Range("G" & Numero_Ligne)
    Set rg_Paste = F_Paste.Range("D" & Last_Row_Paste)
    rg_Paste.Value2 = rg_Copy.Value2
    Set F_Copy = Nothing
    Set F_Paste = Nothing
    Set rg_Copy = Nothing
    Set rg_Paste = Nothing
End If

End Sub
Le 18/05/2021 à 23:06

Bonsoir,

une autre proposition en mettant le code sur l'événement "double clic" de la feuille en colonne H :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Not Intersect(Target, Range("H:H")) Is Nothing And Target.Row > 1 Then
        derligne = Feuil1.Range("A" & Rows.Count).End(xlUp).Row + 1
        Feuil2.Range("A" & Target.Row & ":C" & Target.Row & ",G" & Target.Row).Copy _
        Destination:=Feuil1.Range("A" & derligne)
    End If
End Sub

On détecte un double clic en colonne H à partir de la ligne 2, on sélectionne copie les cellules de cette lignes des colonnes A,B,C et G, puis on cherche la première ligne vide de la feuille de destination et on colle à partir de la colonne A.
Lors d'un collage d'une sélection sous Excel, s'il y a des "trous" dans cette sélection, ils ne sont pas recopiés, du coup A,B,C,G sont copiés en A,B,C et D sur la feuille de destination.

Attention ! il n'y a pas de test sur le nombre maxi de 5 copies, ainsi que le contrôle de non redondance de copie (5 fois la même ligne par exemple...)

@ bientôt

LouReeD

Le 19/05/2021 à 00:09

Hello,

une proposition, sur un seul bouton :

Sub Deplacer()

Const Name_F_Copy As String = "Feuil1"

Const Name_F_Paste As String = "Feuil2"

Dim Numero_Ligne As Integer

Dim rg_Copy As Range

Dim rg_Paste As Range

Dim F_Copy As Worksheet

Dim F_Paste As Worksheet

Dim Last_Row_Paste As Long

Numero_Ligne = Application.InputBox("Entrer le numéro de la ligne à copier", Type:=1)

If Numero_Ligne > 0 Then

Set F_Copy = Sheets(Name_F_Copy)

Set F_Paste = Sheets(Name_F_Paste)

Set rg_Copy = F_Copy.Range("A" & Numero_Ligne & ":C" & Numero_Ligne)

Last_Row_Paste = F_Paste.Cells(Rows.Count, 1).End(xlUp).Row + 1

Set rg_Paste = F_Paste.Range("A" & Last_Row_Paste & ":C" & Last_Row_Paste)

rg_Paste.Value2 = rg_Copy.Value2

Set rg_Copy = F_Copy.Range("G" & Numero_Ligne)

Set rg_Paste = F_Paste.Range("D" & Last_Row_Paste)

rg_Paste.Value2 = rg_Copy.Value2

Set F_Copy = Nothing

Set F_Paste = Nothing

Set rg_Copy = Nothing

Set rg_Paste = Nothing

End If

End Sub

Salut et Merci Rag02700,

Je trouve ta proposition très intéressante, ce qui limite considérablement le nombre de bouton. Seul hic, c'est que, la feuille d'origine contient plus d'une centaine de lignes, comment faire suivre le bouton au fur et à mesure que je descend dans la feuille ? Y a-il un moyen de "figer" un bouton de macro (comme l'entête d'un tableau) de façon à ce que le bouton suive quand je suis sur la 100ème ligne, par exemple, que le bouton ne reste pas en haut et que je soit obligé de remonter la feuille au début pour appuyer sur le bouton ?

Merci.

Le 19/05/2021 à 00:14

Bonsoir,

une autre proposition en mettant le code sur l'événement "double clic" de la feuille en colonne H :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Cancel = True

If Not Intersect(Target, Range("H:H")) Is Nothing And Target.Row > 1 Then

derligne = Feuil1.Range("A" & Rows.Count).End(xlUp).Row + 1

Feuil2.Range("A" & Target.Row & ":C" & Target.Row & ",G" & Target.Row).Copy _

Destination:=Feuil1.Range("A" & derligne)

End If

End Sub

On détecte un double clic en colonne H à partir de la ligne 2, on sélectionne copie les cellules de cette lignes des colonnes A,B,C et G, puis on cherche la première ligne vide de la feuille de destination et on colle à partir de la colonne A.

Lors d'un collage d'une sélection sous Excel, s'il y a des "trous" dans cette sélection, ils ne sont pas recopiés, du coup A,B,C,G sont copiés en A,B,C et D sur la feuille de destination.

Attention ! il n'y a pas de test sur le nombre maxi de 5 copies, ainsi que le contrôle de non redondance de copie (5 fois la même ligne par exemple...)

@ bientôt

LouReeD

Salut et merci LouReeD,

C'est une excellente idée, mais comment la mettre en œuvre ? C'est une macro sans bouton, si je comprend bien ? Comment dois-je procéder ?

Merci.

EDIT : J'ai réussi mais le soucis est que le code par double-click agit sur la feuille 2, or j'aurais besoin qu'il agisse sur la colonne "H" de la feuille 1 , et que le résultat apparaisse sur la feuille 2, les 5 lignes maxi, les unes sous les autres ! Merci

Le 19/05/2021 à 18:47

J'ai utilisé les "CodeName" VBA des feuilles, mais pour plus de clarté vous pouvez remplacer par exemple "Feuil1.Range" par "Sheets("Feuil2").Range"

En effet, votre feuille 1 sous excel correspond au CodeName Feuil2 sous VBA.
Le CodeName est le premier nom de l'objet feuille sous VBA le nom de l'onglet sous Excel est quant à lui indiqué entre parenthèse à droite de ce CodeName.

Le code étant une "surveillance événementielle" de la feuille, il doit être coller sur la feuille sous VBA.

@ bientôt

LouReeD

Le 19/05/2021 à 18:53

Hello,

@croac tu insères le bouton sur la même ligne que tes en-têtes et tu figes la ligne des en-têtes, ton bouton reste en haut et accessible.

Le 20/05/2021 à 11:20

Bonjour LouReeD et Rag02700,

Merci pour vos réponses, pour mon classeur d'essai, c'est ok pour vos 2 méthodes !

Maintenant, j'ai un soucis sur mon classeur d'origine, j'ai effectué les changements qui me paraissaient logique mais j'ai un problème avec les 2 méthodes :

Méthode de LouReeD : Lorsque je double-clique sur une ligne de la colonne "J" que j'ai choisie, cela me renvois une erreur de débogage ! Je penses savoir pourquoi (sur mon classeur d'essai, la colonne "quantité" est en bout de ligne, contrairement à mon classeur original) mais je ne sais pas comment m'en sortir !

Méthode de Rag02700 : Je clique sur le bouton, je sélectionne la ligne, elle est bien copiée/collée, mais lorsque je sélectionne une nouvelle ligne, cette dernière remplace la précédente plutôt que de s'ajouter dessous !

Je sais que je suis embêtant mais, je vous joins le classeur initial, si vous pouvez me donner, à nouveau, un coup de main...... (j'aurais peut-être dû vous envoyer mon classeur initial dès le début....).

Merci de votre patience !

Pour info, la "feuille 1" est remplacée par "CARRELAGE" et la "feuille 2" par "INVENTAIRE".

16stock-depot-et-mag-par-casier-secour-copie.xlsm (38.80 Ko)
Le 20/05/2021 à 15:13

Bonjour,

comme expliqué sur un précédent message il faut si vous utilisez le noms des onglets des feuilles mettre Sheets("Nom de l'onglet de la feuille"), sinon mettre le CodeName de la feuille sous VBA : Feuil1 par exemple.

Votre fichier corrigé avec le nom des onglet du classeur :

17stock-depot-et-mag-par-casier-secour-copie.xlsm (43.57 Ko)

Attention, il n'y a toujours pas la vérification de redondance des lignes choisie ni la limitation à 5 lignes.

@ bientôt

LouReeD

Le 20/05/2021 à 18:22

Hello,

Last_Row_Paste = F_Paste.Cells(Rows.Count, 1).End(xlUp).Row + 1

La colonne 1 de la feuille de réception ou "collage" doit toujours avoir une valeur. C'est la colonne de référence pour déterminer la dernière ligne.

Si celle ci n'est pas toujours remplie alors vous pouvez remplacer le "1" de :

(Rows.Count, 1)

par un autre nombre (par exemple 2 si la colonne de référence est la B)

Le 20/05/2021 à 21:49

Bonjour,

comme expliqué sur un précédent message il faut si vous utilisez le noms des onglets des feuilles mettre Sheets("Nom de l'onglet de la feuille"), sinon mettre le CodeName de la feuille sous VBA : Feuil1 par exemple.

Votre fichier corrigé avec le nom des onglet du classeur :

1stock-depot-et-mag-par-casier-secour-copie.xlsm (43.57 Ko)

Attention, il n'y a toujours pas la vérification de redondance des lignes choisie ni la limitation à 5 lignes.

@ bientôt

LouReeD

Bonsoir LouReeD,

Je l,avais bien compris et modifié sauf que j'avais inversé le nom des feuilles et je n'avais pas mis les parenthèses !

Ça fonctionne, en revanche, les valeurs ne correspondent pas avec les colonnes.

Je voudrais copier respectivement, la colonne "D", puis les colonnes de "A" à "C", et enfin la colonne "E", j'ai essayé de modifier la ligne, mais il doit me manquer quelque chose :

Sheets("CARRELAGE").Range("D" & Target.Row & ",A" & Target.Row & ":C" & Target.Row & ",E" & Target.Row).Copy _

Merci et désolé pour l'acharnement ! (Je ne maitrise pas les codes VBA)

Le 20/05/2021 à 22:18

Hello,

Last_Row_Paste = F_Paste.Cells(Rows.Count, 1).End(xlUp).Row + 1

La colonne 1 de la feuille de réception ou "collage" doit toujours avoir une valeur. C'est la colonne de référence pour déterminer la dernière ligne.

Si celle ci n'est pas toujours remplie alors vous pouvez remplacer le "1" de :

(Rows.Count, 1)

par un autre nombre (par exemple 2 si la colonne de référence est la B)

Bonsoir Rag02700,

C'est ok, nickel !

Pour finir, je désirerais ajouter un copier/coller de la valeur de la colonne "D" de la feuille source vers la colonne "A" de la feuille cible, j'ai modifié le code mais une erreur subsiste, peux-tu vérifier le code ci-dessous et me dire ce qui ne va pas et, si possible, me l'expliquer !

J'ai ajouté les lignes 4, 5 et 6 !

If Numero_Ligne > 0 Then
    Set F_Copy = Sheets(Name_F_Copy)
    Set F_Paste = Sheets(Name_F_Paste)
    Set rg_Copy = F_Copy.Range("D" & Numero_Ligne)
    Set rg_Paste = F_Paste.Range("A" & Last_Row_Paste)
    rg_Paste.Value2 = rg_Copy.Value2
    Set rg_Copy = F_Copy.Range("A" & Numero_Ligne & ":C" & Numero_Ligne)
    Last_Row_Paste = F_Paste.Cells(Rows.Count, 5).End(xlUp).Row + 1
    Set rg_Paste = F_Paste.Range("B" & Last_Row_Paste & ":D" & Last_Row_Paste)
    rg_Paste.Value2 = rg_Copy.Value2
    Set rg_Copy = F_Copy.Range("E" & Numero_Ligne)
    Set rg_Paste = F_Paste.Range("E" & Last_Row_Paste)
    rg_Paste.Value2 = rg_Copy.Value2

Merci et désolé, je néophyte en la matière !

Le 21/05/2021 à 00:46

@LouReeD

Re-bonsoir,

C'est bon, tout est ok, j'ai réussi à modifier le code, mais pas sans mal (pour quelqu'un qui ne connait pas le langage VBA) !

Voici le code modifié :

Sheets("CARRELAGE").Range("D" & Target.Row).Copy _
Destination:=Sheets("INVENTAIRE").Range("A" & derligne)
Sheets("CARRELAGE").Range("A" & Target.Row & ":C" & Target.Row & ",E" & Target.Row).Copy _
Destination:=Sheets("INVENTAIRE").Range("B" & derligne)

Encore merci pour tout !

Le 21/05/2021 à 00:54

@Rag02700

Re-bonsoir,

J'ai réussi à modifier le code, tout est ok. Comme j'ai dis juste dessus à LouReeD, je ne connait pas le langage VBA, mais avec un peu de logique (pas sans mal), je suis parvenu à mes fins !

Voici le code modifié :

If Numero_Ligne > 0 Then
    Set F_Copy = Sheets(Name_F_Copy)
    Set F_Paste = Sheets(Name_F_Paste)
    Set rg_Copy = F_Copy.Range("A" & Numero_Ligne & ":C" & Numero_Ligne)
    Last_Row_Paste = F_Paste.Cells(Rows.Count, 5).End(xlUp).Row + 1
    Set rg_Paste = F_Paste.Range("B" & Last_Row_Paste & ":D" & Last_Row_Paste)
    rg_Paste.Value2 = rg_Copy.Value2
    Set rg_Copy = F_Copy.Range("D" & Numero_Ligne)
    Set rg_Paste = F_Paste.Range("A" & Last_Row_Paste)
    rg_Paste.Value2 = rg_Copy.Value2
    Set rg_Copy = F_Copy.Range("E" & Numero_Ligne)
    Set rg_Paste = F_Paste.Range("E" & Last_Row_Paste)
    rg_Paste.Value2 = rg_Copy.Value2

Encore merci pour tout !

Le 21/05/2021 à 11:17

Bonjour,

Merci pour ce retour !

@ bientôt

LouReeD

Rechercher des sujets similaires à "creer macros chaque lignes"