Copier une ligne en sélectionnant avec la souris une Cellule

Bonjour,

Je suis entrain de buter sur une macro

Je vous donne le script:

  • étape n°1: ôter la protection de la feuille
  • étape n°2: afficher un message: " sélectionner une cellule dans la ligne à copier"
  • étape n°3: si sur la ligne sélectionner la colonne AU est vide
Alors afficher le message "Désoler mais cette ligne ne peut pas être copier, veuillez sélectionner une autre ligne du tableau"

Si oui revenir à l'étape 2,

Si non sortir de la macro

Si sur la ligne sélectionner la colonne AU est non vide alors copier la ligne sélectionner

  • étape n°4: afficher un message : "sélectionner une cellule sur la ligne au dessus de la ligne à insérer"
  • étape n°5: si sur le ligne sélectionner la colonne AU égale 1
Alors afficher le message " Désoler mais il ne peut être inséré une ligne dans cette zone, voulez vous sélectionner une autre ligne"

Si oui revenir à l'étape 4

Si non sortie de la macro

Sinon insérer une ligne en dessous de la ligne active

  • étape n°6: Coller la ligne copier, sur la ligne insérer
  • étape n°7: Protéger la feuille de calcul.

NB: les lignes à copier et à insérer sont dans un tableau

J'arrive bien pour les étapes 1,2 et 7, c'est plus compliqué pour le reste.

Si après la macro que j'ai commencer à écrire.

Sub Copier_insére_coller_ligne() ' 'étape n°1: ôter la protection de la feuille de calcul' ActiveSheet.Unprotect Password:="*****" 'étape n°2: sélectionner la ligne à copier' Dim rng As Range On Error Resume Next Set rng = Application.InputBox _ (prompt:="Sélectionner une cellule dans la ligne à copier", Type:=8) If rng Is Nothing Then Exit Sub End If 'étape n°3: valider la possibilité de copier la ligne sélectionner' If Range("AU"& Range(rows.Activate))="<>" Then Msgbox("Désoler mais cette ligne ne peut pas être copier. Voulez vous sélectionner une autre ligne du tableau",vbYesNo) ' étape n°7: mettre la protection de la feuille' ActiveSheet.Protect Password:="*****", DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub

et après je bugue complet je sais pas comment le tourner

Merci de votre aide

Salut Sylvain,

...sera p'têt ben un peu compliqué à déchiffrer pour toi : beau crêpage de neurones en vue!

Si tu ne t'en sors pas, je te mettrai des commentaires!

Public Sub CopyRow()
'
Dim rCel As Range, iRow%, iRowA%, iRowB%, iOK%
'
ActiveSheet.Unprotect Password:="*****"
Application.DisplayAlerts = False
On Error Resume Next
Cancel = True
'
For x = 1 To 2
    Do
        iRow = 0
        iOK = 0
        Set rCel = Nothing
        Set rCel = Application.InputBox(prompt:=IIf(x = 1, "Sélectionnez une cellule dans la ligne à copier", _
                "Sélectionnez à présent la ligne d'insertion au-dessus de la ligne à copier"), Type:=8)
        If Not rCel Is Nothing Then
            iRow = rCel.Row
            If Range("AU" & iRow).Value = IIf(x = 1, "", 1) Then
                MsgBox IIf(x = 1, "Désolé mais cette ligne ne peut pas être copiée !", "Désolé !" & Chr(10) & "Il ne peut être inséré de ligne dans cette zone !") & _
                Chr(10) & "Veuillez sélectionner une autre ligne du tableau.", vbCritical + vbOKOnly, "Choix ligne"
                iOK = 1
            End If
        End If
        If iOK = 0 And iRow > 0 Then
            If x = 1 Then iRowA = iRow
            If x = 2 Then
                iRowB = iRow
                Rows(iRowB + 1).Insert shift:=xlDown
                Rows(iRowB + 1).Value = Rows(iRowA + 1).Value
            End If
        End If
    Loop Until iOK = 0 Or iRow = 0
    If iRow = 0 Then
        MsgBox "Procédure de copie annulée par l'utilisateur !", vbInformation + vbOKOnly, "Copie - Info"
        Exit For
    End If
Next
'
ActiveSheet.Protect Password:="*****", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.DisplayAlerts = True
On Error GoTo 0
'
End Sub

A+

4sylvainbis.xlsm (24.79 Ko)

Merci pour tout j'essai de me crêper les neurones ce soir si je suis pas trop fatigué

Bonjour,

Je suis en train de me pencher sur la macro.

J'aurais jamais rédiger ça comme cela. mais c'est très intéressant.

J'ai vu que la macro avais été insérer dans la feuille et non dans un module. A terme j'aurais plusieurs feuille sur laquelle je souhaiterai utiliser cette macro. j'avais donc le réflexe de vouloir mettre la macro dans le module. Mais quand je fais ça, cela ne marche plus, j'ai "Erreur de compilation: Variable non définie " sur "Cancel= True". J'ai pas bien compris à quoi sert cette expression. et s'il vraiment utile de mettre la macro dans le Modules.

Merci pour vos infos

Salut Sylvain,

Cancel = True est un oubli...

Je testais la macro sur un double-clic, d'où cette instruction.

Si tu dois utiliser cette macro dans plusieurs feuilles, il faut alors placer le coeur du code dans son homologue événementiel du module VBA de 'ThisWorkbook' OU, effectivement, dans un Module1 si on l'appelle avec CALL.

Il suffit de mettre des garde-fous pour éviter les soucis.

Á toi de voir ce qui te convient.

Si tu as besoin d'aide, tu connais l'adresse...

A+

Parfait après les petites modif faite sa marche parfaitement

voir fichier joint

Encore merci pour ton aides curulis57.

je crois que j'aurai tourner en rond pendant longtemps pour arriver à la tordre celle-là.

Reste à moi a faire la macro jumelle pour supprimer une ligne

Avec le fichier c'est mieux

10sylvainbis-3.xlsm (20.70 Ko)
Rechercher des sujets similaires à "copier ligne selectionnant souris"