supprimer et copier avec conditions

Bonjour JB,

Essaie ceci :

Un fichier de sauvegarde peut toujours être utile ;-))
'-----------------------------------------
Sub SupprimerDesLignes()

Dim Rg As Range, Nb As Long
Dim A As Long, B As Long, C As Long
With Worksheets("Feuil3")
Set Rg = .Range("B1:B" & .Range("A65536").End(xlUp) _
.Row).SpecialCells(xlCellTypeBlanks)
Nb = Rg.Areas.Count
For A = Nb To 1 Step -1
B = Rg.Areas(A).Rows.Count
For C = B To 1 Step -1
If WorksheetFunction.CountIf(.Range("A:A"), _
Rg.Areas(A).Rows(C).Offset(, -1)) = 1 Then
Rg.Areas(A).Rows(B).EntireRow.Delete (xlUp)
End If
Next
Next
End With
Set Rg = Nothing
End Sub
'-----------------------------------------


Salutations!




"JB" <jb@free.fr> a écrit dans le message de news: mn.6d197d542bf3636d.30888@free.fr...
Bonsoir

ce code m'a été donné et qui marche tres bien merci sur ce forum et
pour cette fonction

Soit 2 colonnes

A B
112 j@toto.fr
112 b@toto.fr
113
114 zz@ww.fr
114

Je souhaiterai supprimer la ligne entiere et la copier dans une autre
feuille pour
les lignes qui son vides en B et qui sont unique en A

Dans mon exemple seul la ligne 113 répond a cette condition



Sub test()
For i = [a65536].End(xlUp).Row To 1 Step -1
If Application.CountIf([a:a], Cells(i, 1)) = 1 _
And IsEmpty(Cells(i, 2)) Then
With Sheets("feuil2")
ligne = .[a65536].End(xlUp).Row + 1
.Rows(ligne).value = Rows(i).value
End With
Rows(i).Delete
End If
Next
End Sub


Je souhaiterai la modifier pour que maintenant
la ligne 113 et les 2 lignes 115 sont concernées et doivent être
déplacés dans la feuille:

A B
112 j@toto.fr
112 b@toto.fr
113
114 zz@ww.fr
114
115
115


Milles merci

--
Ceci est une signature automatique de MesNews.
Site : http://www.mesnews.net