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

Signaler
Messages postés
51
Date d'inscription
mardi 2 juillet 2019
Statut
Membre
Dernière intervention
2 août 2019
-
 Ray974 -
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.

3 réponses

Messages postés
15256
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
3 août 2020
1 318
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??
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.
Messages postés
15256
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
3 août 2020
1 318
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
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.
Messages postés
15256
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
3 août 2020
1 318
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.
Messages postés
51
Date d'inscription
mardi 2 juillet 2019
Statut
Membre
Dernière intervention
2 août 2019

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.
Messages postés
15256
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
3 août 2020
1 318
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
Re,

D'accord merci.