Déplacement contenu d'une cellule à l'autre - Macro

Bonjour,

Je souhaite créer une macro me permettant de déplacer le contenu d'une cellule à une autre sur la même ligne mais sur une autre colonne.

Sachant que je souhaite déplacer la cellule sélectionnée seulement de présent vers absent, et n'utiliser qu'un seul bouton.

Par exemple, je voudrais déplacer "jc" sur C3 ou déplacer "franck" sur C4 et non les deux en même temps, avec un seul bouton.

image

Dans l'attente de votre aide, je vous remercie beaucoup.

JCR

Bonjour, et bienvenue,

Une proposition avec une procédure évènementielle (double-clic cellule).

Les données sont sous forme de tableau structuré.

Cdlt.

41informatique.xlsm (15.06 Ko)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Me.Range("Data")) Is Nothing And Target.Count = 1 Then
        If Not IsEmpty(Target) Then
            Cancel = True
            Select Case Target.Column
                Case 1:
                    With Target
                        .Offset(, 1).Value = Target.Value
                        .Value = vbNullString
                    End With
                Case 2:
                    With Target
                        .Offset(, -1).Value = Target.Value
                        .Value = vbNullString
                    End With
            End Select
        End If
    End If
End Sub

Bonjour Jean-Eric, merci beaucoup pour ce retour rapide !!!

Votre solution est très intéressante.

Cependant, je souhaiterais pouvoir déplacer les noms sur une deuxième colonne, je vous transmet une copie écran du tableau en question que je réalise pour ma hiérarchie, je pensais que le modèle initial suffisait pour exprimer ma demande :

image

Ici, j'ai dû créer des macro-commandes pour chaque déplacement et pour chaque ligne (chaque nom), et mon souhait serait de créer une seule fois les boutons

image

pour effectuer mon action, cela m'éviterait de créer des boutons sur chaque ligne et d'alourdir également le VBA de macro-commandes.

Par exemple, je veux que le nom "ESPINASSE Marie ANGE" (le nom que je sélectionne) se déplace à la colonne "AFFECTÉ", je clique sur Bouton "A" en jaune et le nom se déplace sur F8. Idem pour les autres actions/boutons.

Aussi, j'ai créé le Bouton "Flèche" Retour, car si le nom disparaissait sur une mauvaise manipulation de boutons, cette flèche régénère le nom à sa place initiale.

Votre macro pourrait m'être utile si elle pouvait faire la distinction entre les différentes cibles (ABSENT, AFFECTÉ, PRÉSENT, et autre colonne à créer éventuellement.

Encore merci pour votre aide !!!

JCR

Bonjour,

je me suis laisser tenté pour la première fois (il y'a un début à tout) à essayé de répondre à une question et j'ai testé un bout de code.

Dis moi si cela convient à ta demande

Sub Absent()

     If Not Intersect(Selection, Range("C:C")) Is Nothing Then

Selection.Cut
Selection.Offset(0, 2).Select
ActiveSheet.Paste

Application.CutCopyMode = True

     End If

     If Not Intersect(Selection, Range("F:F")) Is Nothing Then

    Selection.Cut
    Selection.Offset(0, -1).Select
    ActiveSheet.Paste

Application.CutCopyMode = True

     End If

End Sub
----------------------------------------------------------------------------------------------------------------------
Sub Affecté()

     If Not Intersect(Selection, Range("C:C")) Is Nothing Then

Selection.Cut
Selection.Offset(0, 3).Select
ActiveSheet.Paste

Application.CutCopyMode = True

     End If

     If Not Intersect(Selection, Range("E:E")) Is Nothing Then

    Selection.Cut
    Selection.Offset(0, 2).Select
    ActiveSheet.Paste

Application.CutCopyMode = True

     End If

End Sub
----------------------------------------------------------------------------------------------------------------------
Sub Présent()

     If Not Intersect(Selection, Range("E:E")) Is Nothing Then

Selection.Cut
Selection.Offset(0, -2).Select
ActiveSheet.Paste

Application.CutCopyMode = True

     End If

     If Not Intersect(Selection, Range("F:F")) Is Nothing Then

    Selection.Cut
    Selection.Offset(0, -3).Select
    ActiveSheet.Paste

Application.CutCopyMode = True

     End If

End Sub

En ce qui concerne le bouton "flèche", il me semble qu'on ne peur annuler une action VBA via une autre action VBA (je peut certainement me tromper..)

Cordialement.

Bonjour Nico68, j'ai commencé à intégrer la macro absent et ça fonction très bien !!!

je continuerai dans la journée de finaliser mon doc et te tiens au courant.

Merci encore !!! Nikel !!!!

JCR

Nico68, tes macros sont parfaites et fonctionnent comme je le souhaitais !!!

Juste un petit souci que je rencontre, lorsque je clique sur mon bouton, le nom se déplace bien dans la colonne souhaitée, mais les bordures de la cellule deviennent blanches. J'ai rajouté : Selection.borders.value = 1 dans la macro mais ça ne fonctionne pas. Peut-être aurais-tu une dernière astuce à me donner ?

En tout cas merci pour tout !!!

JCR

Bonjour informatique,

content que cela te convienne!

J'avoue faire partie des débutants en vba mais je voulait essayer de m'intégrer. Premier essai quasiment réussi!

Je regarde pour les bordures et je reviens vers toi si je parviens à quelque chose.

Si quelqu'un passant par là à une réponse avant moi je ne lui en voudrais pas.

Nico68, re-bonjour,

J'ai intégré par la suite dans ta macro Range("C:C").Borders.Value = 1 et ça fonctionne. Du coup la macro reforme les bordures de la cellule qui se vide.

Merci beaucoup pour ton aide, ainsi qu'à Jean-Éric également.

Bien à vous et à bientôt :)

JCR

Sub Absent()

If Not Intersect(Selection, Range("C:C")) Is Nothing Then

Selection.Cut

Selection.Offset(0, 1).Select

ActiveSheet.Paste

Application.CutCopyMode = True

Range("C:C").Borders.Value = 1

End If

End Sub

Re,

j'allais tout juste te répondre du coup tu as pris les devants ;)

Par contre je viens de m'apercevoir d'un petit loupé sur le bouton affecté

Voici la Modification

Sub Affecté()

     If Not Intersect(Selection, Range("C:C")) Is Nothing Then

Selection.Cut
Selection.Offset(0, 3).Select
ActiveSheet.Paste

Application.CutCopyMode = True

     End If

     If Not Intersect(Selection, Range("E:E")) Is Nothing Then

    Selection.Cut
    Selection.Offset(0, 1).Select
    ActiveSheet.Paste

Application.CutCopyMode = True

     End If

End Sub

Bonne fin de journée.

Super !! je fais la rectification.

Merci bcp et bonne fin de journée !

jcr

Rechercher des sujets similaires à "deplacement contenu macro"