Re : Recherche et exportation de doublons
Bonsoir,
Remplace ce code
Sub doublons()
On Error Resume Next
Application.ScreenUpdating = False
Sheets("feuil1").Select
MaCellule = ("A1")
Range(MaCellule).Select
ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
While ActiveCell <> ""
If ActiveCell = donnee1 Then
r = ActiveCell.Row
C = ActiveCell.Column
Sheets("feuil2").Cells(r, C) = ActiveCell
Sheets("feuil2").Cells(r, C + 1) = ActiveCell.Offset(0, 1)
Sheets("feuil2").Cells(r, C + 2) = ActiveCell.Offset(0, 2)
Sheets("feuil2").Cells(r, C + 2) = ActiveCell.Offset(0, 3)
Rows(r).Delete
'ActiveCell.EntireRow.Delete
'ActiveCell.Offset(-1, 0).Select
donnee1 = ActiveCell.Offset(-1, 0)
'ActiveCell.Offset(-1, 0).Select
Else
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
End If
Wend
Sheets("feuil2").Select
'supprime lignes vides
Range("A2:A65000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Value = "doublons"
End Sub
Cdt