Insertion de plusieurs lignes en fonction d'une valeur avec une incrementation [Résolu]

Messages postés
51
Date d'inscription
mardi 2 juillet 2019
Statut
Membre
Dernière intervention
2 août 2019
- - Dernière réponse :  Ray974 - 15 juil. 2019 à 12:24
Bonjour à tous,

Je suis nouvelle dans ce forum, j'ai besoin d'aide sur mon code VBA, je suis débutante et je suis bloquée.
Dans mon code, je veux insérer des lignes en fonction d'un nombre dans une cellule et je veux que quand j’insère la ligne qu'il me fasse une incrémentation de certains valeurs.
> Je suis bloquée sur l' incrémentation , j'arrive à mettre une ligne par ligne et je veux que par exemple dans une cellule j'ai le chiffre 5 et il me met par la suite 5 lignes.
> Voici le code
>
> Private Sub CommandButton2_Click()
>
>
> Application.ScreenUpdating = False
> Dim AJ As Long
> AJ = ActiveCell.Row
> With ActiveSheet
> .Rows(AJ).Insert shift:=xlDown
> .Rows(AJ).EntireRow.Hidden = False
> ' met les lignes en fonction de la cellule
'Sheets(1).Select
> 'Range("C6").Select
> 'i = Range("C6").Value
> 'Rows("7:" : 6 + i : "").Select
> 'Selection.Insert shift:=xlDown
> 'recopie les valeurs précedent dans la nouvelle ligne
> Application.Calculation = xlCalculationManual
> .Range("B" : AJ) = .Range("B" : AJ - 1).Formula
> .Range("C" : AJ) = .Range("C" : AJ - 1).Formula
> .Range("D" : AJ) = .Range("D" : AJ - 1).Formula
> .Range("K" : AJ) = .Range("K" : AJ - 1).Formula
> .Range("L" : AJ) = .Range("L" : AJ - 1).Formula
> .Range("M" : AJ) = .Range("M" : AJ - 1).Formula
> .Range("N" : AJ) = .Range("N" : AJ - 1).Formula
> ' je veux incrementer
> .Range("AD" : AJ) = .Range("AD" : AJ - 1).Formula + .Range("AD" : AJ - 1)
> End With
> Application.CutCopyMode = False
> Application.Calculation = xlCalculationAutomatic
> Application.ScreenUpdating = True
>
> End Sub



Merci d'avance pour votre attention et votre aide.
Afficher la suite 

3 réponses

Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
Bonjour,

 'i = Range("C6").Value 

C'est cette cellule qui donne le nombre de lignes??
Y a un bleme avec ceci entre autre:
 'Rows("7:" : 6 + i : "").Select 

Pourquoi de : ald &!!!!!!
Pourquoi une plage de code qui devrait vous servir est en commentaire??
Ray974
Messages postés
51
Date d'inscription
mardi 2 juillet 2019
Statut
Membre
Dernière intervention
2 août 2019
-
Bonjour,

Le premier c’était un exemple et celui là c'est ce que j'ai dans ma base.
f894009
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177 -
Re,

Fichier modife: https://mon-partage.fr/f/Yvi5uX7t/
Par contre:
_les recopies de cellules vous verrez bien, mais avis, va pas cadrer; Increment ok
_Vous ne pourrez le faire qu'une seule fois car y a rien qui indique que pour une ou plusieurs personnes c'est deja a jour
Ray974
Messages postés
51
Date d'inscription
mardi 2 juillet 2019
Statut
Membre
Dernière intervention
2 août 2019
-
quand , j'essaye le code il fonctionne mais il me met des lignes partout.
f894009
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177 -
Re,

Devrait aller mieux: https://mon-partage.fr/f/FXP1u0Sq/
Mais toujours pareil ne peut se faire qu'une seule fois
Salut, c'est presque ça mais quand j'ajoute les lignes au début Sava mais j'en mets plus il e met avant la ligne et même il fait plus l'incrémentation.
en tout qu'a merci pour ton attention.
Commenter la réponse de f894009
Messages postés
51
Date d'inscription
mardi 2 juillet 2019
Statut
Membre
Dernière intervention
2 août 2019
0
Merci
Bonjour le forum,

Pouvez vous m'aider sur le complément de mon code?
J'ai réussi à mettre les lignes mais je n'arrive pas à copier la ligne précédente sur les lignes insérées et à faire une incrémentation sur un colonne.

Merci d'avance pour votre aide.
Application.ScreenUpdating = False
'déclaration des variables
Dim message As String, title As String
Dim nblg As Byte
Dim I As Long

I = ActiveCell.Row
'on prépare les infos pour le message box
message = "Entrez le nombre de lignes"
title = "Insérer lignes"
'demande le nombre de lignes à insérer
nblg = Application.InputBox(message, title, Type:=1)
'test pour sortir au cas ou l'utilisateur rentre 0 ligne
If nblg = 0 Then MsgBox "Le nombre de lignes est à zéro": End

'copie de la dernière ligne remplie
Rows(I).Copy

Rows(I).Resize(nblg, 1).Insert Shift:=xlShiftDown 'Insertion par copie des nouvelles lignes
Rows(I + 1).Resize(nblg).ClearContents 'on efface le contenu des lignes copiées pour avoir des lignes vierges
L = Range("U" & nblg)
LD = nblg + 1
LF = nblg + L - 1
NPF = 1
LD = LD - 1
LF = LF
For m = LD To nblg
Range("AG" & m) = NPF
NPF = NPF + 1
Next m
nblg = nblg + L
Range("B" & nblg & ":D" & nblg).Copy Range("B" & LD & ":D" & LF)
Range("L" & nblg & ":M" & nblg).Copy Range("L" & LD & ":M" & LF)






Merci.
Commenter la réponse de Ray974
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
Bonjour,

Ok, je regarde la chose

Sub test()
    'd?claration des variables
    Dim message As String, title As String
    Dim nblg As Long
    Dim I As Long

    'Application.ScreenUpdating = False
    I = ActiveCell.Row
    'on pr?pare les infos pour le message box
    message = "Entrez le nombre de lignes"
    title = "Insertion lignes"
    'demande le nombre de lignes ? ins?rer
    nblg = Application.InputBox(message, title, Type:=1)
    'test pour sortir au cas ou l'utilisateur rentre 0 ligne
    If nblg = 0 Then MsgBox "Le nombre de lignes est ? z?ro": End    'copie de la derni?re ligne remplie
    LD = I + 1
    LF = I + nblg
    Rows(LD & ":" & LF).Insert Shift:=xlShiftUp 'Insertion par copie des nouvelles lignes
    Range("B" & I & ":D" & I).Copy Range("B" & LD & ":D" & LF)
    Range("L" & I & ":M" & I).Copy Range("L" & LD & ":M" & LF)
    NPF = 1
    LD = I
    LF = LF
    For m = LD To LF
        Range("AG" & m) = NPF
        NPF = NPF + 1
    Next m
End Sub
Commenter la réponse de f894009