Discussion :

[fares paris]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Marc-L]

Bonjour,

il manque déjà un \ à la fin de la constante PATH !

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[fares paris]

Je ne vois pas ou le placer j'ai essayer plusieurs locations en vain et n'ai obtenu que des messages d'erreur.

[EngueEngue]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const PATH = "C:\Users\Documents\RK\"

[fares paris]

Le lien a ete copié, jai quand meme ajouté le \ manquant mais My_File="" donc la fonction se termine sans peupler mon document.

[EngueEngue]

Et bien aucun csv dans ce path