Import de donnees .csv d'un dossier a un tableur excel.
Bonjour, J'ai un dossier nome RK contenant un certain nombre de fichiers .csv ayant une seule Worksheet et dont les données sont séparées par des ";".J’ai besoin d’importer tous ces fichiers sur des onglets différents nommés comme leurs fichiers d’origine sur un même document Excel.
Ci-dessous un code que j’ai trouvé en ligne légèrement modifié selon mes besoins. Quand je fais tourner la macro j’obtiens My_file = "" .comment devrais-je modifier le code. Merci pour votre aide.
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
| Public Sub Load_text_Files()
Const PATH = "C:\Users\Documents\RK"
Dim My_Filenumber As Integer
Dim My_File As String
Dim My_Data As String
Dim My_Array As Variant
Dim WS As Worksheet
My_File = Dir(PATH & "*.csv")
If My_File = "" Then
'MsgBox "No Files found matching " & PATH & My_Extension
Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'remove any worksheet in workbook except current worksheet
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> ActiveSheet.Name Then
WS.Delete
End If
Next
'load each file
While My_File <> ""
AddSheetIfMissing (My_File)
Worksheets(My_File).Activate
My_Filenumber = FreeFile
With ActiveSheet
Open PATH & My_File For Input As #My_Filenumber
While Not EOF(My_Filenumber)
Line Input #My_Filenumber, My_Data
My_Array = Split(My_Data, ";") 'split the string at every comma.... store result in any array
.Range(Cells(.Range("A65536").End(xlUp).Row + 1, 1), Cells(.Range("A65536").End(xlUp).Row + 1, UBound(My_Array))) = My_Array 'output the array into each column
Wend
Close My_Filenumber
My_File = Dir 'get next file
End With
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function AddSheetIfMissing(Name As String) As Worksheet
On Error Resume Next
Set AddSheetIfMissing = ThisWorkbook.Worksheets(Name)
If AddSheetIfMissing Is Nothing Then
Set AddSheetIfMissing = ThisWorkbook.Worksheets.Add
AddSheetIfMissing.Name = Name
End If
End Function |
