Copie ligne si cellule contient (Collage spé. & pas effacer)

Le 03/02/2016 à 10:58

Bonjour,

Mon problème est assez difficile, j'ai un code en vba qui me copie des lignes dans un autre onglet si dans une cellule un critère est présent.

Le problème est que si la ligne disparaît de l'onglet de départ, et qu'elle est remplacée par une autre, elle viendra écrasé la copie préalable..se que je ne veux pas..

De plus il me faut un copié coller de valeurs uniquement.

Je joins un petit fichier dans lequel tout est bien clair. Le code VBA est dedans.

Merci de votre aide !!!

45exemple.zip (13.49 Ko)
Le 03/02/2016 à 12:55

Bonjour,

Dans le code remplace

Ligne = 9

par

ligne = Sheets("REX").Range("F" & Sheets("REX").Rows.Count).End(xlUp).Row
If ligne < 9 Then ligne = 9 Else ligne = ligne + 1

Si ok, merci de clôturer le fil en cliquant sur la case à cocher verte à coté du bouton EDITER

Crdlt

Le 03/02/2016 à 13:02

Merci de ton aide et c'est pas mal du tout par contre ça me fait des doublons de partout (se qu'il ne faut pas) et se n'est pas des collages spéciaux de valeurs..

On y est presque !!!! (Je traine ça depuis 3 jours ça me gonfle un tentiné xD)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sh, i, DernCol As Integer
Dim Wb_dest As String
Dim Wb_dep As String

Application.ScreenUpdating = False

Wb_dep = ActiveWorkbook.Name
'Récupération de la position de la cellule active
lgn = ActiveCell.Row
Col = ActiveCell.Column

'Copie des lignes avec conditions
ligne = Sheets("REX").Range("F" & Sheets("REX").Rows.Count).End(xlUp).Row
If ligne < 9 Then ligne = 9 Else ligne = ligne + 1
For i = 2 To Workbooks(Wb_dep).Sheets(1).Range("A65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(1).Range("F" & i) = "ACTIF" Then
Workbooks(Wb_dep).Sheets(1).Range("A" & i & ":G" & i).Copy Workbooks(Wb_dep).Sheets(2).Range("A" & ligne)
ligne = ligne + 1
End If
Next i

' Repositionnement sur la cellule
Sheets("DT-OT").Select
Sheets("DT-OT").Cells(lgn, Col).Select

End Sub
Le 03/02/2016 à 17:46

Re,

Ok mais dans ton fichier il me faut savoir quelle est la colonne de référence à contrôler afin de voir si elle n'existe déjà pas dans la feuille REX.

Là au vu de tes données, impossible de savoir. Donc le code copie tout à chaque nouvelle donnée arrivant dans la feuille DT-OT

crdlt

Le 03/02/2016 à 18:18

Aaah ok dzl j'avais oublié ça.. Et c'est en colonne A qu'il faut vérifier pour éviter les doublons !!

Le 03/02/2016 à 18:23

Re

Donc le nom du client ?? là j'ai "client 3" plusieurs fois mais cela vient de plusieurs feuilles. On fait quoi dans ce cas ?

Le 03/02/2016 à 18:31

oui pardon le fichier est vraiment un exemple.... mais dans mon vrai fichier c'est bien dans la colonne A qu'il faut faire la comparaison et c'est des numéros donc à limite tu peux mettre 1, 2, 3, 4, etc

Tant que la comparaison est faite après j'adapte les critères sur mon fichier réel.

Le 03/02/2016 à 18:51

Re

On parle bien de la feuille REX ?

Si oui, on peut vérifier si il y a un doublons.

Quelle est ta version d'excel 2010 ou 2007 ?

Le 03/02/2016 à 18:54

Oui c'est bien ça dans la feuille REX et 2007 au boulot.....

Le 03/02/2016 à 19:09

Re

j'ai pas vérifié sous windows mais juste avant le END SUB, mets cette ligne

Sheets("REX").Range("A1:E" & Sheets("REX").Range("A" & Sheets("REX").Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=(1), Header:=xlNo

Cordialement

Edit Dan

Le 03/02/2016 à 19:20

Ok mais dzl je peux tester que demain.....

merci !!!! et est ce que ça me fait un copier coller de valeur uniquement sans les formules ???

Le 03/02/2016 à 19:23

Re

Le code prendra les valeurs et pas les formules

Le 04/02/2016 à 09:18
Dan a écrit :

Re

Le code prendra les valeurs et pas les formules

Hello !!!

Je viens de tout tester et d'adapter à mon fichier.

Tout va bien exepté qu'il ne sagit pas d'un copiage valeurs :/ Toutes les formules sont copiées collées et en plus lors du copiage je ne sais pas trop comment ça se passe mais si je mes une ligne au hasard dans l'onglet de départ disons en ligne 200.

La ligne est bien rapatrié seulement, toutes les formules font alors référence à la ligne d'arrivée...

Bref, il me faut vraiment un copiage valeur ^^

Pour faciliter je te joins le vrai fichier.. Le statut est en colonne K (toujours le statut ACTIF en critère) et la colonne à vérifier pour les duplicatas est la colonne B.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long
Dim j As Integer, dlg As Integer

Application.ScreenUpdating = False

Wb_dep = ActiveWorkbook.Name
'Récupération de la position de la cellule active
lgn = ActiveCell.Row
Col = ActiveCell.Column

'Copie des lignes avec conditions
ligne = Sheets("REX").Range("K" & Sheets("REX").Rows.Count).End(xlUp).Row
If ligne < 4 Then ligne = 4 Else ligne = ligne + 1
For i = 2 To Workbooks(Wb_dep).Sheets(1).Range("A6000").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(1).Range("K" & i) = "ACTIF" Then
Workbooks(Wb_dep).Sheets(1).Range("A" & i & ":U" & i).Copy Workbooks(Wb_dep).Sheets(2).Range("A" & ligne)
ligne = ligne + 1
End If
Next i

' Repositionnement sur la cellule
Sheets("DT-OT").Select
Sheets("DT-OT").Cells(lgn, Col).Select

Sheets("REX").Range("A5:U" & Sheets("REX").Range("B" & Sheets("REX").Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=(2), Header:=xlNo

End Sub

Bon euuuuh le forum n'a pas envie que je joigne le fichier xD impossible de le joindre....

Le 04/02/2016 à 12:56

Re

Oups désolé pour ma réponse, mais je me suis trompé dans ma réponse qui était dédiée à un autre fichier

A quoi sert le "Repositionnement sur la cellule active" ?

Dans le code la première ligne est sur la ligne 4 alors qu'initialement c'est la 9. Qu'en est-il exactement ?

Crdlt

Le 04/02/2016 à 14:11

Re !!

Bah écoute c'est une très bonne question ^^ Je ne sais pas à quoi sert le repositionnement...

Ceci dit, j'ai re-ouvert un post pour le problème du copier coller de valeur qui a été résolu assez rapidement.

Voici le code final qui fonctionne =)

Ceci étant, si j'inscri des choses dans une ligne qui a déjà été copié ça ne se met pas à jours dans l'onglet REX....c'est assez embétant en fait..

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long
Dim j As Integer, dlg As Integer

Application.ScreenUpdating = False

Wb_dep = ActiveWorkbook.Name
'Récupération de la position de la cellule active
lgn = ActiveCell.Row
Col = ActiveCell.Column

'Copie des lignes avec conditions
ligne = Sheets("REX").Range("K" & Sheets("REX").Rows.Count).End(xlUp).Row
If ligne < 4 Then ligne = 4 Else ligne = ligne + 1
For i = 2 To Workbooks(Wb_dep).Sheets(1).Range("A6000").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(1).Range("K" & i) = "ACTIF" Then
Workbooks(Wb_dep).Sheets(1).Range("A" & i & ":U" & i).Copy
Workbooks(Wb_dep).Sheets(2).Range("A" & ligne).PasteSpecial xlPasteValues

ligne = ligne + 1
End If
Next i

' Repositionnement sur la cellule
Sheets("DT-OT").Select
Sheets("DT-OT").Cells(lgn, Col).Select

Sheets("REX").Range("A5:U" & Sheets("REX").Range("B" & Sheets("REX").Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=(2), Header:=xlNo

End Sub
Dan a écrit :

Dans le code la première ligne est sur la ligne 4 alors qu'initialement c'est la 9. Qu'en est-il exactement ?

Crdlt

Alors oui !! C'est un peu le bazarre pour s'y retrouver mais c'est dû au fichier exemple qui lui est en 9 alors que le fichier réel est en 4..

Le 04/02/2016 à 14:29

Re

Ta première ligne dans le feuille REX est bien la 9 ?

Le 04/02/2016 à 14:31

Dans l'exemple oui !! Mais pas dans mon fichier réel ..

Dzl ça embrouille ce n'est pas habile de ma part d'avoir mis une telle différence sur mon fichier exemple..

Le 04/02/2016 à 14:35

Re

Oui un peu

Sinon voici le code que tu peux utiliser

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long, ligne As Long
Dim wb_dep As String
Dim j As Byte

Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
wb_dep = ActiveWorkbook.Name

'Copie des lignes avec conditions
ligne = Sheets("REX").Range("K" & Sheets("REX").Rows.Count).End(xlUp).Row
If ligne < 9 Then ligne = 9 Else ligne = ligne + 1
    For i = 9 To Workbooks(wb_dep).Sheets(1).Range("A" & Workbooks(wb_dep).Sheets(1).Rows.Count).End(xlUp).Row
        If Workbooks(wb_dep).Sheets(1).Range("K" & i) = "ACTIF" Then
            For j = 1 To 21
                Workbooks(wb_dep).Sheets(2).Cells(ligne, j) = Workbooks(wb_dep).Sheets(1).Range("A" & i)
            Next
        ligne = ligne + 1
    End If
Next i
With Sheets("REX").Range("A5:U" & .Range("B" & .Rows.Count).End(xlUp).Row)
    .RemoveDuplicates Columns:=(2), Header:=xlNo
    .Copy
    .PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Crdlt

Le 04/02/2016 à 14:40

Message d'erreur première ligne dans le PrivateSub...

"Erreur de compilation,

Référence incorrecte ou non qualifié"

Lors du message d'erreur il met en jaune la première ligne et il sélectionne le .Rows du With !! ??

Le 04/02/2016 à 19:27

re

Oui normal. Désolé...

Juste après Next i, remplace cette partie de code

With Sheets("REX")
    With .Range("A5:U" & .Range("B" & .Rows.Count).End(xlUp).Row)
        .RemoveDuplicates Columns:=(2), Header:=xlNo
        .Copy
        .PasteSpecial Paste:=xlValues
    End With
End With

Cordialement

Rechercher des sujets similaires à "copie ligne contient collage spe pas effacer"