Bonjour!

Quand j'ouvre le fichier excel, le message d'erreur suivant apparait:

"Désolé...Nous avons trouvé un problème dans le contenu de NomDuFichier.xlsm, mais nous pouvons essayer de récupérer le maximum de contenu. Si la source de ce classeur est fiable, cliquez sur Oui."

Après avoir cliqué sur "Oui", un second message d'erreur apparaît:

"Excel a pu ouvrir le fichier en supprimant ou en réparant le contenu illisible:
- Enregistrements supprimés: Tri dans la partie /xl/worksheets/sheet2.xml"

Excel me force ensuite à enregistrer une nouvelle version du fichier, si j'ai utilité le macro, lors de la réouverture de celui-ci.

J'utilise un macro VBA pour trier automatiquement les données puis pour éliminer les dupliqués. Voici le code de Sheet2.xlm:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
Private Sub CommandButton2_Click()
 
'TRIER LES DONNÉES
Dim FinalRow As Long
 
'Find last used row in destination sheet
FinalRow = Range("A" & Rows.Count).End(xlUp).Row
 
With Worksheets("CTB").Sort
    .SortFields.Add Key:=Range("B1"), Order:=xlAscending
    .SortFields.Add Key:=Range("A1"), Order:=xlAscending
    .SortFields.Add Key:=Range("C1"), Order:=xlAscending
    .SortFields.Add Key:=Range("D1"), Order:=xlAscending
    .SortFields.Add Key:=Range("G1"), Order:=xlAscending
    .SetRange Range("A1:H" & FinalRow)
    .Header = xlYes
    .Apply
 
 End With
 
'***ENLEVER LES DOUBLONS***
Dim x As Integer
Dim y As Integer
Dim LastRow As Long
 
'FIND THE LAST USED ROW IN A SHEET AND COPY PASTE BELOW IT
 
'Find last used row in destination sheet
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
For x = 2 To LastRow
 
For y = LastRow To 2 Step by - 1
 
    If Worksheets("CTB").Range("A" & x).Value = Worksheets("CTB").Range("A" & y).Value _
        And Worksheets("CTB").Range("B" & x).Value = Worksheets("CTB").Range("B" & y).Value _
        And Worksheets("CTB").Range("C" & x).Value = Worksheets("CTB").Range("C" & y).Value _
        And Worksheets("CTB").Range("D" & x).Value = Worksheets("CTB").Range("D" & y).Value _
        And x <> y _
    Then
        Worksheets("CTB").Rows(y).Delete
        LastRow = LastRow - 1
 
    End If
 
Next y
 
Next x
 
End Sub
Quelqu'un peut-il m'aider à corriger le code pour éviter l'apparition de messages d'erreur?

Merci!