Bonjour à tous,
J'ai des données en colonne C Et D sur et des lignes 9 à 40.
Je voudrais supprimer les doublons, du moins effacer les données en double uniquement dans les colonnes C et D. Car en colonne E j'ai une formule que je ne veux pas effacer.
Pour le moment, j'ai une macro qui fonctionne mais le hic c'est qu'elle m'efface la ligne complète. Hors je veux seulement qu'elle m'efface les doublons dans la plage ("C9
37")
Sub SupprimeDoublons()
Dim Plage As Range, Cell As Range
Dim Un As New Collection
Dim Tableau() As Integer
Dim x As Integer
Set Plage = Worksheets("Synthèse").Range("C937")
On Error Resume Next
For Each Cell In Plage
Un.Add Cell, CStr(Cell)
If Err.Number <> 0 Then
x = x + 1
ReDim Preserve Tableau(1 To x)
Tableau(x) = Cell.Row
Err.Clear
End If
Next Cell
On Error GoTo 0
If x = 0 Then Exit Sub
Application.ScreenUpdating = False
For x = UBound(Tableau) To LBound(Tableau) Step -1
Worksheets("Synthèse").Rows(Tableau(x)).EntireRow.ClearContents
Next x
Application.ScreenUpdating = True
End Sub
J'ai des données en colonne C Et D sur et des lignes 9 à 40.
Je voudrais supprimer les doublons, du moins effacer les données en double uniquement dans les colonnes C et D. Car en colonne E j'ai une formule que je ne veux pas effacer.
Pour le moment, j'ai une macro qui fonctionne mais le hic c'est qu'elle m'efface la ligne complète. Hors je veux seulement qu'elle m'efface les doublons dans la plage ("C9
37")Sub SupprimeDoublons()
Dim Plage As Range, Cell As Range
Dim Un As New Collection
Dim Tableau() As Integer
Dim x As Integer
Set Plage = Worksheets("Synthèse").Range("C9
37")On Error Resume Next
For Each Cell In Plage
Un.Add Cell, CStr(Cell)
If Err.Number <> 0 Then
x = x + 1
ReDim Preserve Tableau(1 To x)
Tableau(x) = Cell.Row
Err.Clear
End If
Next Cell
On Error GoTo 0
If x = 0 Then Exit Sub
Application.ScreenUpdating = False
For x = UBound(Tableau) To LBound(Tableau) Step -1
Worksheets("Synthèse").Rows(Tableau(x)).EntireRow.ClearContents
Next x
Application.ScreenUpdating = True
End Sub
