bonjour le forum
j'ai une formule qui fonctionne très bien sur 2003 et qui fait un bug sur 2007
si vous pouvez m'aider merci
les supprimes les doubles sur une colonne et trie de A à Z
Sub suppr()
Sheets("nompersonne").Activate
ld = 9 ^ 9
Dim doublons As String
Dim liste As Collection
Set liste = New Collection
Range("a4:a" & Range("a65536").End(xlUp).Row).Sort Key1:=Range("a4"), Order1:=xlAscending, Key2:=Range("a4") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
For n = 1 To Range("a65536").End(xlUp).Row
On Error Resume Next
liste.Add Range("a" & n), CStr(Range("a" & n))
If Err.Number <> 0 Then
doublons = doublons & Range("a" & n) & ","
End If
On Error GoTo 0
Next n
tablo = Split(doublons, ",")
For n = 0 To UBound(tablo)
For m = Range("a65536").End(xlUp).Row To 2 Step -1
If CStr(Range("a" & m)) = tablo(n) Then
If IsEmpty(Range("a" & m)) Then
Rows(m).Delete
Else
x = x + 1
If x > 1 Then Rows(m).Delete
End If
End If
Next m
x = 0
Next n
Sheets("sommaire").Activate
End Sub
mon problème à chaque fois que j'ouvre le dossier il y a un message erreur et je doit enregistrer le tout avec un nouveau nom
David @+
j'ai une formule qui fonctionne très bien sur 2003 et qui fait un bug sur 2007
si vous pouvez m'aider merci
les supprimes les doubles sur une colonne et trie de A à Z
Sub suppr()
Sheets("nompersonne").Activate
ld = 9 ^ 9
Dim doublons As String
Dim liste As Collection
Set liste = New Collection
Range("a4:a" & Range("a65536").End(xlUp).Row).Sort Key1:=Range("a4"), Order1:=xlAscending, Key2:=Range("a4") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
For n = 1 To Range("a65536").End(xlUp).Row
On Error Resume Next
liste.Add Range("a" & n), CStr(Range("a" & n))
If Err.Number <> 0 Then
doublons = doublons & Range("a" & n) & ","
End If
On Error GoTo 0
Next n
tablo = Split(doublons, ",")
For n = 0 To UBound(tablo)
For m = Range("a65536").End(xlUp).Row To 2 Step -1
If CStr(Range("a" & m)) = tablo(n) Then
If IsEmpty(Range("a" & m)) Then
Rows(m).Delete
Else
x = x + 1
If x > 1 Then Rows(m).Delete
End If
End If
Next m
x = 0
Next n
Sheets("sommaire").Activate
End Sub
mon problème à chaque fois que j'ouvre le dossier il y a un message erreur et je doit enregistrer le tout avec un nouveau nom
David @+