Duplication de la ligne avec incrementation

Résolu/Fermé
devimen - 11 avril 2018 à 15:30
 devimen - 16 avril 2018 à 09:24
Bonjour ,

Je suis débutante en VBA et j'ai besoin de votre aide pour modifier ma macro s'il vous plait [​IMG]

mon probléme :
Ma macro fonctionne avec un Menu contextuel [​IMG] .Donc je voudrais quand utilisateur fini a remplir toute une ligne, après quand il clique sur le souris ou s'est nommé "duplication de la ligne " ; un message Box montre n° de trajet de début ,après un autre message Box ,n°de trajet de fin .
Donc a partir de n° trajet de début jusqu’au numéro de trajet de fin , il incrémente avec un +1 , avec recopie de toute la ligne .

'exemple :) :
N° trajet de debut :580
N) trajet de fin: 584
donc je voudrai avoir
581
582
583
584
avec coipe de tout les données de la ligne de n0 de trajet 581 de debut pour les autres numéros de trajet .
' code VBA
Sub dupliquerlignes()
Dim lignes As Integer
Dim debut As Integer
debut = InputBox("N° DE DEBUT ")
fin=InputBox("N °DE FIN ")
For Debut To Fin
With ActiveCell.EntireRow
.Offset(debut, 0).Insert Shift:=xlDown
.Copy Destination:=.Offset(debut, 0)
debut=debut+1
End With
Next debut
End Sub
' Menu contextuel

Private Sub Workbook_Open()
Call Creer_Menu_Contextuel_2
End Sub

Sub Creer_Menu_Contextuel_2()

'réinitialize la sourie comme à l'origine
Application.CommandBars("Cell").Reset

'Crée une commande dans le menu
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Duplication de la ligne" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "dupliquerlignes" 'appel de la macro

End With

End Sub

Sub reset_menudroit()
CommandBars("Cell").Reset
End Sub

j'espere que j'ai bien expliquer mon probléme .
Dans l'attente de vos répense .Je vous remercie d'avance :)
A voir également:

1 réponse

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
11 avril 2018 à 18:18
Bonjour,

je n'ai pas très bien compris cette ligne:

avec coipe de tout les données de la ligne de n0 de trajet 581 de debut pour les autres numéros de trajet .

voir cela si ça correspond à la demande:

Sub dupliquerlignes()
Dim ligne As Integer
Dim i As Integer
Dim debut As Integer
Dim fin  As Integer
debut = InputBox("N° DE DEBUT ")
fin = InputBox("N °DE FIN ")
ligne = ActiveCell.Row 'ligne cellule active
For i = debut To fin
ActiveCell.Copy Destination:=ActiveCell.Offset(i - ligne, 0)
Next i
End Sub

1
Bonjour,
Merci pour votre aide . J'ai essayé votre code . j'ai les Msg box mais j'ai pas de duplication de la ligne et incrémentation :(

Merci pour votre aide
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
12 avril 2018 à 08:15
D'après ce que j'ai compris!

Sub dupliquerlignes()
Dim ligne As Integer
Dim fin  As Integer
fin = InputBox("N °DE FIN ")
ligne = ActiveCell.Row 'ligne cellule active
ActiveCell.AutoFill Destination:=Range("A" & ligne & ":A" & fin), Type:=xlFillDefault 'adapter colonne
End Sub


il faut qu'il y est le numéro saisi dans la cellule active

@+
0
Bonjour,
Merci pour votre reponse ,j'ai pas bien expliquée mon problémé ; Excusez moi s'il vous plait comme je suis debutante sur le forum :( .
exemple :

N° trajet de debut egale a :la cellule active qui est egale à 581
N° trajet de fin sera saisie par Message Box : 584
donc je voudrai avoir
1) 581 a b c
2) 582 a b c
3) 583 a b c
4) 584 a b c
donc : copier la ligne n°1 et la dupliquer pour ligne 2 ,3,4 mais avec incrementation de +1 pour n° de trajet .

J'espere que j'ai bien expliquée. Dans l'attente de votre reponse s'il vous plait :)
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
12 avril 2018 à 11:06
voilà avec les commentaires pour comprendre et adapter le cas échéant:

Option Explicit
Dim var As String 'valeur cellule active
Dim debut As Integer 'numerique cellule active
Dim ligne As Integer ' ligne cellule active
Dim fin  As Integer 'numerique de fin
Dim result As Integer 'nombre de ligne à ajouter
Sub dupliquerlignes()
fin = InputBox("N °DE FIN ")
var = ActiveCell.Value
extractionMots
ligne = ActiveCell.Row
result = fin - debut 'nombre de ligne à ajouter
ActiveCell.AutoFill Destination:=Range("A" & ligne & ":A" & ligne + result), Type:=xlFillDefault 'adapter colonne
End Sub
'Extraire les données séparées par un espace dans une chaine de caractères
Sub extractionMots()
    Dim Tableau() As String
    Dim i As Integer
    
    'découpe la chaine en fonction des espaces " "
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(var, " ")
    
    'boucle sur le tableau pour visualiser le résultat
    For i = 0 To UBound(Tableau)
        'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
        Debug.Print Tableau(i)
    Next i
    debut = Tableau(0) 'numerique cellule active
End Sub


@+ Le Pivert
0
Bonjour,

Merci pour votre reponse ,ça fonctionne trés bien .Merci pour votre aide :) .
Suijet résolu :D
0