aide d'amélioration code VBA

[papoumarc]

Bonjour, pouvez-vous m'aider pour améliorer ce code VBA car je n'y connais rien, il m'a été donné gracieusement sur ce forum, mais je n'ai pas les compétence pour l'améliorer d'où mon appel
tout se trouve dans le fichier
Merci

 

[CISCO]

Bonsoir

Peut être avec

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 12 And Target.Row > 2 Then
  Sheets("Feuil3").Cells.ClearContents
  ligne = 1
  For n = 3 To Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
     If Sheets("Feuil2").Range("L" & n) = 1 Then
        Sheets("Feuil2").Range("A" & n & ":B" & n).Copy Destination:=Sheets("Feuil3").Range("A" & ligne)
        ligne = ligne + 1
     End If
  Next
End If
Sheets("Feuil2").Select
End Sub

@ plus

 

[papoumarc]

Merci Cisco, c'est parfait mais
Est-il possible de faire en sorte que lorsque les lignes ont été reportée en feuille 3 et que l'on efface les lignes en feuille 2, les lignes de la feuille 3 ne s'efface pas pour que lorsqu'on écrit une nouvelle ligne sur les lignes 9 à …., ces nouvelles écritures de lignes n'efface pas les précédentes mais viennent se mettre à la suite des autres donc dans le feuille 3 (dans l'exemple ligne 4)

Merci déjà pour ce beau travail.

 

[Robert]

Bonjour le fil, bonjour le forum,

Puisque la macro est immédiate je ne comprends pas pourquoi une boucle !... Voilà comment je verrais les choses :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim O As Worksheet 'déclare la variable O (onglet)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

If Target.Column = 12 And Target.Row > 2 Then 'condition 1 : si le changement a lieu dans la colonne 12 (=L) et à partir de la ligne 3
    Set O = Worksheets("Feuil3") 'définit l'onglet O
    'définit la cellule de destination DEST (A1, si A1 est vide, sinon la première cellule vide de la colonne A de l'ongelt O)
    Set DEST = IIf(O.Range("A1").Value = "", O.Range("A1"), O.Range("A" & Application.Rows.Count).End(xlUp).Offset(1, 0))
    If Target.Value = 1 Then 'condition 2 : si la valeur éditée est égale à 1
        Cells(Target.Row, 1).Resize(1, 2).Copy DEST 'copie dans DEST les deux premières colonnes de la ligne éditée
        Rows(Target.Row).Delete Shift:=xlShiftUp 'supprime la ligne éditée
    End If 'fin de la condition 2
End If 'fin de la condition 1
End Sub

 

[papoumarc]

Merci Robert pile poil ce qu'il me faut un tout grand Merci