Problème sur une macro

bbobb

XLDnaute Occasionnel
Bonsoir à tous,
J'ai besoin d'aide sur la macro cisdessous. La macro a fonctionnée jusqu'à ce que je rajoute une commande pour suprimer les doublons; le message d'erreur est : "End Sub attendu".

Merci d'avance pour votre aide.
Bbobb

' Ouverture du fichier et copie des données dans l'onglet "retour"
Sheets("Retour").Select
Nom_appli = ActiveWorkbook.Name
col_retour = 1
Do
col_retour = col_retour + 1
Loop Until Cells(3, col_retour) = ""

Date_retour = Cells(2, col_retour)
sem_retour = Cells(1, col_retour)
If Date_retour > Cells(2, 1) Then
MsgBox "Date inadaptée, fichier non encore généré.", vbCritical, "ACTION IMPOSSIBLE"
GoTo fin
End If

Valannee = Year(Cells(2, col_retour))
ValMois = Month(Cells(2, col_retour))
If ValMois < 10 Then
ValMois = "0" & ValMois
End If
Valjour = Day(Cells(2, col_retour))
If Valjour < 10 Then
Valjour = "0" & Valjour
End If

Nom_fic = "D:\Parking\Save Parkéon\Auto " & Valannee & "\" & Valannee & "_" & ValMois & "_" & Valjour & "\data\cheque.txt"
Workbooks.OpenText Filename:= _
Nom_fic, Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
Range("A6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Copy
Windows(Nom_appli).Activate
Cells(3, col_retour).Select
ActiveSheet.Paste

Windows("cheque.txt").Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False

' Suppression des doublons
Sub supDoublonsTradi()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
Next i
Application.Calculation = xlCalculationAutomatic
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 216
Messages
2 086 348
Membres
103 194
dernier inscrit
rtison