Copie ligne si cellule contient

Bonjour,

Tout est dans le titre je voudrais une macro qui me copie (copie de valeur) automatiquement toutes les lignes comportant un statut à l'état ACTIF en colonne K vers une autre feuille et ce toutes les lignes les unes derrières les autres.

J'ai un code permettant la copie dont j'ai besoin il n eme manque que la condition en fait.. Et aussi comment faire pour que la macro fasse ça tout le temps sans appuyer sur un bouton et en ne faisant pas de doublon.

Sub copie()
  Application.ScreenUpdating = False
  Rows(ActiveCell.Row).Copy
  Sheets("REX").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
  Application.CutCopyMode = False
End Sub

Pour info mon onglet 1 s'appel DT-OT et mon onglet 2 s'appel REX.

Merci beaucoup pour votre aide !!!!!

588exemple.zip (10.64 Ko)

Bonjour,

Merci de joindre un fichier.

Demande édité le fichier joins est là !! =)

Bonjour,

Pas trop le temps ce matin.

Regarde le fichier joint. Cela ressemble beaucoup à ta demande

Il s'agissait du post ci dessous. Plusieurs versions

https://forum.excel-pratique.com/excel/copier-des-cellules-dans-une-autre-feuille-sous-condition-t73395.html

Si besoin je regarde plus tard

1'406adherentsv002be05.xlsm (21.68 Ko)

Wow !! alors effectivement c'est à peu près se que je cherche par contre je ne veux pas que ça se supprime !!!

Essaie si tu peux d'adapter à ta problématique.

Pour ne pas supprimer.

Je pense qu'il suffit de supprimer l'effacement de la feuille 2 et de bien repositionner pour l'écriture des nouvelles données

Bon courage

Sur ton fichier ça marche !! =)

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

'effacements des données de la feuille "Adhérents"
'Sheets("Adhérents").Select
'    Sheets("Adhérents").Range("A4").Select
 '   Sheets("Adhérents").Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
  '  Selection.ClearContents
'Sheets("Adhérents").Range("A4").Select

Ligne = 4
For i = 2 To Workbooks(Wb_dep).Sheets(1).Range("A65536").End(xlUp).Row
If Workbooks(Wb_dep).Sheets(1).Range("I" & i) = "X" Then
Workbooks(Wb_dep).Sheets(1).Range("A" & i & ":I" & i).Copy Workbooks(Wb_dep).Sheets(2).Range("A" & Ligne)
Ligne = Ligne + 1
End If
Next i

' Repositionnement sur la cellule
Sheets("Liste CDMG").Select
Sheets("Liste CDMG").Cells(lgn, Col).Select

End Sub

En suppriment tout bêtement la partie supression comme tu l'as dit c'est nickel !! =) Il ne reste plus qu'à l'adapter à mon fichier =) Je passerai résolu à ce moment merci en tout cas !! =)

Bon !!

Le code est adapté à mon fichier let j'ai plusieurs soucis..

1) il fait un copier coller classique >>> il me faut un collage spécial valeur uniquement

2) si dans le tableau de départ une ligne qui a été copié dans le 2e tableau est remplacé par une autre, elle remplacera la copie précédente. >>> et je veux juste qu'elles viennent toutes se mettre les unes après les autres..

En gros c'est la merde ^^ j'arrive pas à modifier pour avoir le collage spécial et coller les une en dessous des autres....

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 = 5
For i = 2 To Workbooks(Wb_dep).Sheets(1).Range("A65536").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

End Sub

Le code à modifier au dessus et en dessous le code qui permet le collage spécial valeur uniquement et qui colle les un après les autres.. j'utilisais cette macro il faut sélectionner la ligne à copier et cliquer sur le bouton de la macro ça marche nickel !! =)

Mais il me faut ça avec condition et automatique...

Sub copie()
  Application.ScreenUpdating = False
  Rows(ActiveCell.Row).Copy
  Sheets("REX").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
  Application.CutCopyMode = False
End Sub

Merci d'avance !!!

Rechercher des sujets similaires à "copie ligne contient"