Supprimer les lignes identiques

Salut , j'ai eu ce code la qui me permette d'effacer les lignes identique , mais malheureusement il prend en consideration la formule de la cellule et pas la valeur j'ai remplacé cette ligne

Cible = Cell

par

Cible = Cell.value 

mais c'Est toujours la meme chose

voici le code au complet :

Option Explicit

Sub SupprimerLignesDoublons()

Dim Cell As Range
Dim Ligne As Integer, i As Integer
Dim M As Byte, j As Byte, N As Byte
Dim Tableau(), Tableau2()
Dim Cible As String, Resultat As String
Dim U As Boolean

Ligne = Range("A65536").End(xlUp).Row
M = 1
N = 1
ReDim Preserve Tableau(M)
ReDim Preserve Tableau2(N)

Application.ScreenUpdating = False
For Each Cell In Range("A2:A" & Ligne)
U = False
Cible = Cell

For j = 1 To 42
Cible = Cible & Cell.Offset(0, j)
Next j
For i = 1 To M
If Cible = Tableau(i - 1) Then '
Tableau2(N - 1) = Cell.Row
N = N + 1
ReDim Preserve Tableau2(N)
U = True
End If
Next i

If Tableau(M - 1) = "" And U = False Then
Tableau(M - 1) = Cible
M = M + 1
ReDim Preserve Tableau(M)
End If
Next Cell

End Sub

Bonjour,

Essayer avec ce code qui supprime les lignes identiques dans la plage utilisée pour les colonnes 1 à 42

Sub SupprimerLignesDoublons()

Dim i As Integer
Dim colonnes()

With ActiveSheet.UsedRange
    For i = 0 To 41
        ReDim Preserve colonnes(i)
        colonnes(i) = i + 1
    Next
    .RemoveDuplicates Columns:=(colonnes), Header:=xlNo
End With

End Sub

Hello ,

Merci pour ta réponse , ça fonctionne pas :/ peut etre a cause des formules qui se trouvent dans les cellules et qui renvoient des valeurs .

Bonjour,

Essaie ceci sur une copie de ton fichier (pas l'original).

Cdlt.

Option Explicit
' Supprime les lignes identiques d'une base données
' Warning ! Restitue les données en lieu et place des données existantes
Public Sub DeleteDuplicates()
Dim ws As Worksheet
Dim Dict As Object
Dim a, b()
Dim x As String
Dim I As Long, J As Long
Dim k As Long, m As Long

    Set ws = ActiveSheet
    a = ws.Cells(1).CurrentRegion.Value
    Set Dict = CreateObject("scripting.dictionary")
    'Dict.CompareMode = vbTextCompare

    For I = 1 To UBound(a, 1)
        x = ""
        For J = 1 To UBound(a, 2): x = x & a(I, J): Next J
        Dict(x) = ""
    Next I

    ReDim b(1 To Dict.Count, 1 To UBound(a, 2))
    Set Dict = CreateObject("scripting.dictionary")
    'Dict.CompareMode = vbTextCompare
    m = 0

    For I = 1 To UBound(a, 1)
        x = ""
        For J = 1 To UBound(a, 2): x = x & a(I, J): Next J
        If Not Dict.exists(x) Then
            m = m + 1
            For k = 1 To UBound(a, 2): b(m, k) = a(I, k): Next k
            Dict(x) = ""
        End If
    Next I

    Application.ScreenUpdating = False
    With ws.Cells(1)
        .CurrentRegion.ClearContents
        .Resize(UBound(b), UBound(b, 2)) = b
    End With

    Set Dict = Nothing: Set ws = Nothing

End Sub

Je ne pense pas que ce soit un problème de formule car je viens de tester ce cas. Il s'agit bien de lignes identiques allant de la colonne 1 à 42 ?

Sinon, peux-tu communiquer un extrait représentatif de ton fichier.

Merci Thev ça marche à merveille c'etait 43 cellules , je me suis trompé

**Code simple et compréhensible (Y)