Sub Traitement_dossiers()
Dim dossier1$, dossier2, remplace, par, chemin$, fichier$, n&, i, a, nom$
dossier1 = "Fichiers CSV corrigés\" 'nom du sous-dossier, modifiable
dossier2 = "Fichiers XLS\" 'nom du sous-dossier, modifiable
'remplace = Array("é", "É", "Ã~¨", "â", "½", "Références catalogue", "Date d'émission", "Date d'expiration") 'liste modifiablee
'par = Array("é", "É", "è", "â", "½", "Nums", "Date d_émission", "Date d_expiration") 'liste modifiable
remplace = Array("Références catalogue", "Date d'émission", "Date d'expiration") 'liste modifiable
par = Array("Nums", "Date d_émission", "Date d_expiration") 'liste modifiable
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker) 'sélection du dossier
If .Show = False Then Exit Sub
chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
If Dir(chemin & dossier1, vbDirectory) = "" Then MkDir chemin & dossier1
If Dir(chemin & dossier2, vbDirectory) = "" Then MkDir chemin & dossier2
'---traitement des fichiers csv---
fichier = Dir(chemin & "*.csv") '1er fichier csv du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si les fichiers sont déjà créés
While fichier <> ""
n = n + 1
'Workbooks.OpenText chemin & fichier, Comma:=True, DecimalSeparator:=".", Local:=True
Workbooks.Open chemin & fichier
With ActiveWorkbook.Sheets(1)
.Rows("1:6").Delete
i = .Range("A" & .Rows.Count).End(xlUp).Row
.Rows(IIf(i < 3, 1, i - 2)).Resize(3).Delete '3 dernières lignes
For i = 0 To UBound(par)
.Cells.Replace remplace(i), par(i), xlPart
Next i
i = InStr(fichier, "_csv")
nom = IIf(i, Left(fichier, i), "stamps_") & .Cells(2, 2)
.SaveAs chemin & dossier1 & nom & ".csv", 6 'format csv
.Columns(17).HorizontalAlignment = xlCenter 'centrage de FaceValue
nom = "X_" & .Cells(2, 2)
.SaveAs chemin & dossier2 & nom & ".xls", 56 'format xls
End With
ActiveWorkbook.Close
fichier = Dir 'fichier suivant
Wend
MsgBox IIf(n, n & " fichier" & IIf(n = 1, "", "s") & " CSV traité" & IIf(n = 1, "...", "s..."), "Aucun fichier CSV trouvé...")
End Sub