Suppression de doublons sur 2 feuilles

Bonjour,

Dans un fichier de 4 feuilles je souhaite supprimer les doublons des feuil2 et feuill4.

Le bouton qui lance la macro est sur feuill1

J'ai donc ce code qui fonctionne mais je sais qu'il peut être plus simple par une boucle mais je n'arrive pas à la faire...

Pouvez vous me filer un petit coup de pouce

Sub SupDoublonsTest()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Sheets("feuil2").Select
   Range("A4").Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess
   For i = [A65000].End(xlUp).Row To 4 Step -1
     If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
   Next i
   Sheets("feuil4").Select
   Range("A4").Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess
   For i = [A65000].End(xlUp).Row To 4 Step -1
     If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
   Next i
   Application.Calculation = xlCalculationAutomatic
   Sheets("feuil1").Select
End Sub

Edit : avec le fichier c'est mieux...

Bonjour

Une autre manière (parmi beaucoup d'autres)

Option Explicit

Sub SupDoublonsTest()
Dim LesFeuilles
Dim I As Integer, ModeCalcul As Integer
Dim J As Long

  With Application
    .ScreenUpdating = False
    ModeCalcul = .Calculation
    .Calculation = xlCalculationManual
  End With

  LesFeuilles = Array("Feuil2", "Feuil4")

  For I = 0 To UBound(LesFeuilles)
    With Sheets(LesFeuilles(I))
      .Range("A4").CurrentRegion.Sort Key1:=.Range("A5"), Order1:=xlAscending, Header:=xlGuess
      For J = .Range("A" & Rows.Count).End(xlUp).Row To 6 Step -1
        If .Cells(J, 1) = .Cells(J - 1, 1) Then .Rows(J).Delete
     Next J
    End With
  Next I

  Application.Calculation = ModeCalcul
End Sub

Bonjour,

Ma petite contribution

Option Explicit
Public Sub Supprimer_doublons()
'Ctrl + w
'A partir d'Excel 2007
Dim Ws As Worksheet
Dim Derligne As Long
Dim Plage As Range

    Application.ScreenUpdating
    Set Ws = Worksheets("test")
    Derligne = Ws.Range("A" & Rows.Count).End(xlUp).Row
    Set Plage = Ws.Range("A4").CurrentRegion
    Plage.RemoveDuplicates Columns:=Array(1, 12), Header:=xlYes

    Set Ws = Nothing: Set Plage = Nothing

End Sub

Merci beaucoup à vous 2

Je vais étudier les 2 possibilités.

Jean-eric, dans ta macro, tu as à partir de 2007, mois je suis en 2003, donc pas compatible ?

Quelqu'un peut m'expliquer pour les boucle for avec le step ?

Solution de Banzai

For J = .Range("A" & Rows.Count).End(xlUp).Row To 6 Step -1

La partie "Row To 6 Step -1" me pose un soucis de compréhension.

pourquoi partir de la ligne 6 et pas de la 5 et à quoi sert "step -1" sert à quoi ?

Bonjour

Lorsque l'on supprime des lignes, le plus simple est de partir de la fin donc .Range("A" & Rows.Count).End(xlUp).Row indique la dernière ligne

6 indique la dernière ligne à faire le test : If .Cells(J, 1) = .Cells(J - 1, 1) Then onc on va comparer la ligne 6 avec la ligne ....5 qui elle est la première ligne de ton tableau (on ne compte pas la ligne des titres)

Et le Step -1 parce qu'il faut indiquer le sens de la boucle dans ce cas ==> "enlèves 1 à chaque tour" pour partir de la fin (du plus grand) vers le début (le plus petit)

Par défaut le Step (pas) est positif et est égal à 1

Merci pour l'explication

Juste pour voir si j'ai bien compris le principe, si quelqu'un veut bien me corriger si j'ai fait des erreurs.

A partir du code proposé par Banzai, macro 1 critères, voici la macro avec critères dans 3 colonnes A, B et C :

Sub SupDoublons3col()
Dim LesFeuilles
Dim i As Integer, ModeCalcul As Integer
Dim J As Long

  With Application
    .ScreenUpdating = False
    ModeCalcul = .Calculation
    .Calculation = xlCalculationManual
  End With

  LesFeuilles = Array("Feuil2", "Feuil4")

  For i = 0 To UBound(LesFeuilles)
    With Sheets(LesFeuilles(i))
      .Range("A4").CurrentRegion.Sort Key1:=.Range("A5"), Order1:=xlAscending, _
      Key2:=.Range("B5"), Order2:=xlAscending, _
      Key3:=.Range("C5"), Order3:=xlAscending, _
      Header:=xlGuess
      For J = .Range("A" & Rows.Count).End(xlUp).Row To 6 Step -1
        If .Cells(J, 1) = .Cells(J - 1, 1) _
        And .Cells(J, 2) = .Cells(J - 1, 2) _
        And .Cells(J, 3) = .Cells(J - 1, 3) _
        Then .Rows(J).Delete
     Next J
    End With
  Next i

  Application.Calculation = ModeCalcul
End Sub

Avec cette méthode, on n'est limité à 3 critères non ?

Bonjour

Oui c'est 2003 donc maxi 3 critères

Je sais qu'il existe des astuces (même des macros) pour s'affranchir de cette limite

Une astuce : Prendre une version supérieure

Une autre : Créer une colonne accolée à ton tableau avec une concaténation de tes colonnes à trier et faire le tri sur cette colonne

Pour les macros : uses de ton ami il t'aidera à trouver

Bah disons que d'un point de vu personnel, je me suis offert 2013, mais j'avoue ne pas l'avoir beaucoup utiliser puisque d'un point de vue professionnel on est bloqué à 2003 et pas de changement prévue cette année encore...