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

Question

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.

f894009 · Answer

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 · Answer

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.

f894009 · Answer

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

Insertion de plusieurs lignes en fonction d'une valeur avec une incrementation

3 réponses

Discussions similaires

Newsletters