Recopie d'une ligne

bonjour le forum

dans le fichiers si dessous je voudrai que la ligne en jaune se recopie en dessou, tant que "Approuvé"n'apparait pas dans la cellule D7.

merci pour votre aide

https://www.excel-pratique.com/~files/doc2/recopie1.xls

Bonjour,

Comme on a pas les mêmes couleurs (vert chez moi), il s'agit bien de la ligne 7 ?

faut-il copier aussi la liste colonne D ?

Amicalement

Claude.

Bonjour,

essaie ce code à placer dans la feuille 1

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Macro dan pour CLV le 11/11/2009
Dim dlg As Byte
If Not Intersect(Target, Range("D7")) Is Nothing Then
If Target <> "aprouver" Then
dlg = Range("D65536").End(xlUp).Row
Range("E7:I7").Copy Range("E" & dlg + 1 & ":I" & dlg + 1)
End If
End If
End Sub

Pour mettre en feuille 1, clique droite sur l'onglet puis choisis "visualiserle code". Place le code dans la fenêtre.

Amicalement

Dan

merci Nad-Dan pour ton aide

j'ai recopier ton code mais il s'arrete a la ligne recopier si je selectionne autre chose que "Approuvé" sa ne me recopie pas d'autre ligne.

pardon pour le jaune la ligne est bien verte.

merci

dubois a écrit :

Bonjour,

Comme on a pas les mêmes couleurs (vert chez moi), il s'agit bien de la ligne 7 ?

faut-il copier aussi la liste colonne D ?

Amicalement

Claude.

pardon pour la couleur

oui c bien la ligne 7

re,

Salut Dan,

dans le code de Dan, remplace

dlg = Range("D65536").End(xlUp).Row

par

dlg = Range("e65536").End(xlUp).Row

en +, il faut entrer quelque chose en "E7"

Claude.

re,

Je crois avoir compris ce que tu veux faire,

tu dois entrer des valeurs en ligne 7, peu importe la colonne,

essaye ceci:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim dlg As Integer
    If Not Intersect(Target, Range("D7")) Is Nothing Then
        If WorksheetFunction.CountA(Range("e7:i7")) = 0 Then Exit Sub

        If Target <> "aprouver" Then
            dlg = Cells.Find("*", , , , xlByRows, xlPrevious).Row
            Range("E7:I7").Copy Range("E" & dlg + 1 & ":I" & dlg + 1)
            Range("E7:I7").ClearContents
        End If
    End If
End Sub

la ligne 7 est effacée à chaque saisie

si pas de rentrée, pas de ligne en +

Claude.

re je te remerci pour ta réponse dubois

mais je préfererai que sa me rajoute une ligne vierge en dessous incluant aussi la cellule D7. c'est a dire la ligne 7 de D a I

merci pour votre aide

re,

Alors CLV essaie ce que je t'ai proposé en remplaçant cette ligne

Range("E7:I7").Copy Range("E" & dlg + 1 & ":I" & dlg + 1) 

par

Range("D7:I7").Copy Range("D" & dlg + 1 & ":I" & dlg + 1) 

Dan

Si ok, n'oublie pas de metter RESOLU sur le fil. Explications ici https://www.excel-pratique.com/forum/viewtopic.php?t=13

merci nad-dan

mais je ne peut faire qu'une seul copie de la ligne alors que je voudrai que tant que "approuver"n'apparait pas en D7 sa continu a copier une ligne.

merci pour votre aide

Re,

Je n'ai pas l'impression d'avoir compris ce que tu veux au vu de ton fichier. Je pense que ce que Claude et moi -même avons compris c'est que tu choisis une valeur dans la liste en D7 et si on ne trouve pas le mot "Aprouver" on recopie la ligne D7 à I7, en dessous de la dernière ligne du tableau.

Si ce n'est pas cela que tu veux mets nous un fichier plus explicite.

Dan

oui c'est ce que je veut,mais jusqu'a présent je ne peut recopier que une seule ligne.

merci

Salut le forum

CLV, essaye de mieux expliquer ta demande, c'est vraiment trop vague.

Mytå

Usb512 a écrit :

Salut le forum

CLV, essaye de mieux expliquer ta demande, c'est vraiment trop vague.

Mytå

boujour a tous

voila dans le ficher suivant Nad-Dan ma donnée un code pour recopier la ligne en vert tant que on ne sélèctionne pas approuver la la petite liste de la premiere cellule de la ligne.sont code fonctionne mais ne me permet de ne recopier qu'une seule ligne,alors que j'aimerai que les lignes se recopies tant que "approuver"n'est pas selectionné.

merci a tous

https://www.excel-pratique.com/~files/doc2/CllaLrecopie1.xls

Bonjour,

Pas la peine de répéter toujours la même chose, on ne comprends pas ce que tu dis !

Peut-être veux-tu que la macro fonctionne sur toutes le listes de la colonne D ?

alors que pour l'instant elle ne marche que pour la cellule D7

On ne va pas passer le réveillon là-dessus !!!

Claude.

édit: dernière tentative pour ma part:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Claude pour CLV le 12/11/2009
Dim Lg As Integer
Lg = Range("d65536").End(xlUp).Row
    If Not Intersect(Target, Range("d7:d" & Lg)) Is Nothing Then
        Application.EnableEvents = False
            If Target <> "aprouver" Then
                Range("D7:I7").Copy Destination:=Range("d" & Lg + 1)
            End If
    End If
        Application.EnableEvents = True
End Sub

dubois a écrit :

Bonjour,

Pas la peine de répéter toujours la même chose, on ne comprends pas ce que tu dis !

Peut-être veux-tu que la macro fonctionne sur toutes le listes de la colonne D ?

alors que pour l'instant elle ne marche que pour la cellule D7

On ne va pas passer le réveillon là-dessus !!!

Claude.

édit: dernière tentative pour ma part:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Claude pour CLV le 12/11/2009
Dim Lg As Integer
Lg = Range("d65536").End(xlUp).Row
    If Not Intersect(Target, Range("d7:d" & Lg)) Is Nothing Then
        Application.EnableEvents = False
            If Target <> "aprouver" Then
                Range("D7:I7").Copy Destination:=Range("d" & Lg + 1)
            End If
    End If
        Application.EnableEvents = True
End Sub

et bien voila c'est tout a fait ce que je rechercher,je m'excuse de ne pas m'exprimer assez bien.

une derniere petite question,sur ce principe quand la ligne et recopier pourrez je avoir la premiere case vide, prette pour evité les erreurs.

merci de votre patience

c se fonctionnement que je recherche mais il faudrai que se soit la ligne entiére qui soit vide.prette pour etre remplie avec de nouvelles données.

merci

j'ai trouver la solution merci pour votre aide

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'Claude pour CLV le 12/11/2009

Dim Lg As Integer

Lg = Range("d65536").End(xlUp).Row

If Not Intersect(Target, Range("d7:d" & Lg)) Is Nothing Then

Application.EnableEvents = False

If Target <> "aprouver" Then

Range("D7:I7").ClearContents

Range("D7:I7").Copy Destination:=Range("d" & Lg + 1)

End If

End If

Application.EnableEvents = True

End Sub

voici le code réctifier si sa interesse quelqu'un

merci aussi pour votre patience

rebonjour a tous

le code ne fonctionne pas corectement car il efface la premiere ligne pour copier une ligne vide,alors que je veut bien qu'il me copie une ligne vide mais tout en gardant les information noter dans la ligne précédente.

merci

Bonjour,

reviens quand tu sauras ce que tu veux !

On a tout dit sur ce fil, adapte toi-même

Claude.