Import .csv dans .xls (1 .csv par feuille)
Bonjour à tous,
Avant tout j'espère faire cette publication au bon endroit. Après quelques recherches, je n'ai pas (encore) trouvé réponse à mon problème.
Je cherche à construire une macro capable d'importer tous les fichiers .csv d'un dossier donné dans 1 fichier .xls unique, à raison d'1 fichier .csv par feuille dans le fichier .xls
Le dossier de fichiers CSV se trouve dans un emplacement sur mon disque de type:
C:\Users\Antonio\Documents\10- Fichiers CSV
Les fichiers .csv sont nommés en alphanumérique avec le plus souvent 4 à 8 caractères. Chaque feuille devra porter le nom du fichier .csv importé correspondant (sans l'extension .csv) et le fichier .xls doit être distinct du fichier .xls où se trouve la macro, et il sera créé ou recréer à chaque lancement de la macro avec la date du jour.
Voici le code initialisé que je souhaiterai améliorer:
Code:
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
| Sub import_CSV_in_xls()
Dim wbs As Workbook, wfs As Worksheet
Dim rep As String, fic As String, nom As String, feu As String
Dim i As Integer
i = 0
Application.ScreenUpdating = False
rep = ThisWorkbook.Path & "\"
nom = rep & Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & "_" & Format(Date, "yy-mm-dd") & ".xls"
Workbooks.Add
ActiveWorkbook.SaveAs nom, xlNormal
Set wbs = ActiveWorkbook
feu = ActiveSheet.Name
fic = Dir(rep & "C:\Users\Documents\10- Projects")
While fic <> ""
wbs.Sheets.Add after:=wbs.Worksheets(wbs.Worksheets.Count)
ActiveSheet.Name = Left(fic, InStrRev(fic, ".") - 1)
Set wfs = ActiveSheet
i = i + 1
Workbooks.Open (rep & "C:\Users\Documents\10- Projects" & fic)
ActiveSheet.UsedRange.Copy Destination:=wfs.Range("A1")
ActiveWorkbook.Close
fic = Dir
Wend
Application.DisplayAlerts = False
wbs.Sheets(feu).Delete
wbs.Save
wbs.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox i & " fichiers csv enregistrés dans " & nom
End Sub |
Je vous remercie par avance pour votre aide.
