Résolu - Ajout de ligne et recopie un peu spéciale !!!

[Victor21]

Bonjour !!!

Je coince pour une macro déclenchée lors de la saisie dans une cellule (Private Sub Worksheet_Change(ByVal Target As Range)).

Je m'explique : le but est de générer 1 lignes disponible en-dessous de la dernière cellule saisie en K avec les mêmes caractéristiques que la ligne précédente (formules, listes de validation, mefc.)

(Dans le cas présent -extrait du fichier joint- si je saisis une info en K10, une ligne supplémentaire apparaitra en ligne 11, avec les mêmes fonctionnalités que celles du dessus)

S'il était possible, par la même occasion, de recopier vers le bas les infos des colonnes B: D et F:J lorsque K est rempli, ce serait le pérou !!!

Cette recopie ne sera pas systématique, mais je devrais pouvoir me débrouiller pour le test (liste de validation oui/non en K2 ).

D'avance, merci pour toute aide que vous pourrez m'apporter.

 

[Robert]

Re : Ajout de ligne et recopie un peu spéciale !!!

Bonsoir Victor, bonsoir le forum,

En pièce jointe ton fichier modifié avec la macro événementielle Change ci dessous :

Private test As Boolean 'déclare la variable test
 
Private Sub Worksheet_Change(ByVal Target As Range) 'à l'édition d'une cellule dans l'onglet
Dim li As Integer 'déclare la variable li (LIgne)
 
'si l'édition à lieu ailleurs que dans la colonne K, sort de la procédure
If Target.Column <> 11 Then Exit Sub
'si l'édition à lieu ailleurs que dans la première cellule vide de la colonne K, sort de la procédure
If Target.Row <> Cells(Application.Rows.Count, 11).End(xlUp).Row Then Exit Sub
If test = True Then Exit Sub 'si la variable test est vraie, sort de la procédure (évite de boucler sur la procédure Change)
test = True 'définit la variable test
li = Target.Row 'définit la ligne li
Rows(li).Copy Rows(li + 1) 'copie la ligne édité une ligne en dessous
Range(Cells(li + 1, 11), Cells(li + 1, 18)).ClearContents 'efface la plage K:R
If Target.Value = "Non" Then 'condition : si la cellule éditée contient "Non"
    Range(Cells(li + 1, 2), Cells(li + 1, 4)).ClearContents 'efface la plage B:D
    Range(Cells(li + 1, 6), Cells(li + 1, 10)).ClearContents 'efface la plage F:J
    Cells(li + 1, 2).Select 'place le curseur dans la colonne B (à supprimer peut-être...)
End If 'fin de la condition
test = False 'réinitialise la variable test
End Sub

 

[Fo_rum]

Re : Ajout de ligne et recopie un peu spéciale !!!

Bonsoir,

puisque c'est fait :

Private Sub Worksheet_Change(ByVal Target As Range)
         Dim dl As Long
         dl = Cells(Rows.Count, "K").End(xlUp).Row
         If Target.Count > 1 Then Exit Sub
         If Target.Address = "$K$" & dl And Target <> "" Then
                 Application.EnableEvents = False
                 Range("B" & dl & ":Y" & dl).Copy Cells(dl + 1, 2) 'copie tout
                 Range("B" & dl + 1 & ":Y" & dl + 1).ClearContents 'supprime contenus
                 If Target = "Oui" Then
                       Range("B" & dl & ":D" & dl).Copy Range("B" & dl + 1 & ":F" & dl + 1)
                       Range("F" & dl & ":J" & dl).Copy Range("F" & dl + 1 & ":J" & dl + 1)
                 End If
                 Application.EnableEvents = True
         End If
End Sub

 

[youky(BJ)]

Re : Ajout de ligne et recopie un peu spéciale !!!

Bonjour Victor , bonjour Robert,
Comme j'avais fait aussi le fichier mais différement je le met donc.
J'ai peut être zappé des trucs
Bruno

 

[Victor21]

Re : Ajout de ligne et recopie un peu spéciale !!!

Bonsoir Robert, Fo_rum, youky,

Bien qu'assidu (depuis peu, mais passionnément) de ce forum, je suis encore un fois très agréablement surpris par la rapidité des réponses, et par la qualité des propositions.
On cherche parfois des solutions très compliquées alors qu'elles sont à portée de mulot.

Preuve en est la solution de Robert (je n'ai pas encore décortiqué les suivantes) qui consiste à copier tout, et effacer ce qui est inutile, plutôt que se décarcasser à ne copier que ce qui est utile.

Merci mille fois à vous trois, et bonne soirée.
A+ dans ces lignes,