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 |
Partager