XL 2013 Insertion ligne d'un onglet vers un autre

  • Initiateur de la discussion Initiateur de la discussion freeze82
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

freeze82

XLDnaute Nouveau
Bonjour à tous,

J'ai une macro qui fonctionne à peu près comme je le souhaite.

Sur l'onglet "Base" je double clique sur des articles de la colonne D, cela ouvre une fenêtre qui permet de saisir une quantité.
Une fois cliqué sur OK, l'article est envoyé dans l'onglet "doc"

Les articles sont envoyés dans l'onglet "doc" après la dernière ligne remplie.

Serait-il possible de modifier le code pour pouvoir envoyer un article depuis l'onglet "Base" vers l'onglet "doc" en dessous de la cellule active de la colonne C sélectionnée ?

Par exemple, j'aimerais que l'article HIJ de l'onglet "BASE" soit envoyé sous l'article DEF dans l'onglet "doc".
Si dans l'onglet "doc" je sélectionne une autre cellule dans la colonne C, j'aimerais qu'un article puisse être ajouté sous la ligne sélectionnée. Pas systématiquement après la dernière ligne remplie.


Une grand merci à ceux qui pourront m'aider.

Freeze
 

Pièces jointes

Re : Insertion ligne d'un onglet vers un autre

Bonjour Freeze82.

Je te propose une autre solution.
Après avoir entré ta quantité, un InputBox te demande de choisir la ligne où tu souhaites insérer tes données.
Une fois effectuée, on insère une nouvelle ligne et on exporte les valeurs.

Code:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Flag Then Exit Sub
    If Not Application.Intersect(Target, Range("Designation")) Is Nothing Then
        Dim Lg%, Rep$
        Dim r As Range
        With Sheets("doc")
            Lg = .Range("Nota").End(xlUp)(2).Row    '48 maxi
            If .Range("Nota").Row - Lg <= 5 Then
                 Application.CutCopyMode = False
                 .Rows(Lg).Copy
                 .Range(.Rows(Lg), .Rows(Lg + 5)).Insert
                 Application.CutCopyMode = False
                 MsgBox ("Insertion de 5 lignes")
            End If
            
            Rep = InputBox(ActiveCell & Chr(10) & Chr(10) & "Quantité ?")
            If Rep = "" Then Exit Sub
            .Activate
            Set r = Application.InputBox("Sélectionner la ligne d'insertion.", Type:=8)
            Lg = r.Row
            .Rows(Lg).EntireRow.Insert shift:=xlDown
            Target.Offset(0, 5) = Rep
            .Range("c" & Lg) = Target
            .Range("d" & Lg) = Target.Offset(0, 1)
            .Range("e" & Lg) = Target.Offset(0, 10)
            .Range("h" & Lg) = Target.Offset(0, 2)
            .Range("o" & Lg) = Target.Offset(0, 3)
            .Range("j" & Lg) = Target.Offset(0, 4)
            .Range("r" & Lg) = Target.Offset(0, 6)
            .Range("f" & Lg) = Rep
            .Activate
        End With
    End If
End Sub
 
Re : Insertion ligne d'un onglet vers un autre

Serait-il possible d'insérer uniquement les valeurs

Code:
            Target.Offset(0, 5) = Rep
            .Range("c" & Lg) = Target
            .Range("d" & Lg) = Target.Offset(0, 1)
            .Range("e" & Lg) = Target.Offset(0, 10)
            .Range("h" & Lg) = Target.Offset(0, 2)
            .Range("o" & Lg) = Target.Offset(0, 3)
            .Range("j" & Lg) = Target.Offset(0, 4)
            .Range("r" & Lg) = Target.Offset(0, 6)
            .Range("f" & Lg) = Rep
            .Activate

Dans certaines colonnes de l'onglet "doc" je souhaite garder les formules.
Avec cette macro, l'insertion de la ligne se fait très bien mais elle efface l'ensemble des cellules.

Merci

Freeze
 
Re : Insertion ligne d'un onglet vers un autre

Super, merci beaucoup, ça fonctionne comme il faut. 😀

Serait-il possible d'intégrer un exit sub dans le cas où on ne saisi pas de ligne ?

Code:
            Set r = Application.InputBox("Sélectionner la ligne d'insertion.", Type:=8)
            Lg = r.Row

Grand merci

Freeze
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour