Copier/coller ligne si cellule ne contient pas NULL

Bonjour le forum,

Voilà plusieurs jours que j'essaye de trouver une solution (automatique) à mon problème mais que nenni!!!

Alors je me tourne vers vous en espérant que vous pourrez m'aider.

Mon problème est le suivant:

J'aimerais pouvoir: couper/coller les lignes d'une feuille si dans cette ligne et dans la colonne D se ne trouve pas la valeur NULL.

(Feuille 1) Si dans colonne D de la ligne ne se trouve pas la valeur "NULL" alors copier la ligne dans la feuille 2. Mais ne copier que les colonnes A à I

De plus, étant donné qu'il y a plusieurs lignes avec le même ID (colonne A), j'aimerais qu'il ne copie/colle qu'une seule ligne.

Je joins un fichier pour plus de clarté.

Je vous remercie par avance pour votre aide.

Bonjour

Ci joint une proposition de macro simple à lancer avec Ctrl+Maj+T qui a l'air de fonctionner dans ton fichier

Sub Macro1()

'

' Macro1 Macro

'

Sheets("Data_With_period").Select ' vider existant

Rows("2:65000").Select

Selection.Clear

Sheets("Données").Select ' taille de la zone

Range("a1").Select

Selection.CurrentRegion.Select

Selection.End(xlDown).Select

vligf = ActiveCell.Row

Range("a1").Select

Selection.CurrentRegion.Select

Selection.End(xlToRight).Select

vcolf = ActiveCell.Column

Range(Cells(1, 1), Cells(vligf, vcolf)).Select ' tri de la colonne D pour isoler Null

ActiveWorkbook.Worksheets("Données").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Données").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(vligf, 4)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

xlSortNormal

With ActiveWorkbook.Worksheets("Données").Sort

.SetRange Range(Cells(1, 1), Cells(vligf, vcolf))

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Columns("D:D").Select ' recherche du premier null

Selection.Find(What:="NULL", After:=ActiveCell, LookIn:=xlFormulas, _

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False).Select

vlig = ActiveCell.Row - 1 ' dernière ligne à copier

Range(Cells(2, 1), Cells(vlig, 9)).Select

Selection.Copy

Sheets("Data_With_period").Select

Rows("2:2").Select

ActiveSheet.Paste

Cells.Select

Cells.EntireColumn.AutoFit

End Sub

Il y aura surement quelqu'un qui fera plus court...

Ne pas changer le nom des onglets...

Transmis à toutes fins utiles

Cordialement

FINDRH

Bonjour FINDRH et koodbook.

Une autre solution.

Set ws1 = Sheets("Données")
Set ws2 = Sheets("Data_With_period")
ws1.Range("$A$1:$M$65000").RemoveDuplicates Columns:=1, Header:= _
    xlYes
dlws1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For l = 2 To dlws1
    dlws2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    If ws1.Range("D" & l) <> "NULL" Then ws1.Range("A" & l, "I" & l).Copy Destination:=ws2.Range("A" & dlws2)
Next l
ws2.Columns("A:I").AutoFit

Cdlt.

Bonjour FINDRH et Bigdaddy154,

Je vous remercie pour les solutions que vous m'avez apportées.

Elles fonctionnent très bien, il y aurait un petit ajustement à faire.

Si cela aurait été possible, j'aimerais que les doublons ne soient uniquement supprimés sur la Feuille Data_With_Period. Et que toutes les lignes copiées sur la Feuille Data_With_Period soient supprimées de l'onglet Données

Je vous remercie pour votre aide

Re.

Voilà la version corrigée suivant tes demandes par contre j'ai laissé les doublons dans données puisque tu n'as rien précisé.

Cdlt.

Bonjour Bigdaddy154,

Je te remercie, cela fonctionne très bien.

Merci aussi à toi FINDRH.

Et un merci aussi au forum