Bonjour à tous,

Je bloque sur une macro dont le but est l'import de multiple csv dans l'onglet d'un classeur. 

Principe:

J’ai plusieurs fichiers csv dans un répertoire, ils sont nommés en nombres d'ordre croissant (à partir de 1). Je souhaite que les fichiers soit tous importes dans un onglet de mon classeur les uns à la suite des autres

Ma Macro:

Private Sub Import_Data_Click()

Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet:   Set wsMstr = ThisWorkbook.Sheets("Data")
Dim fPath   As String:      fPath = Worksheets("Menu").Cells(4, 1)   'path to CSV files
Dim fCSV    As String
Dim NextCol As Long
Dim FilesInPath As String

'Add a slash at the end if the user forget it
If Right(fPath, 1) <> "" Then
fPath = fPath & ""
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(fPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

If MsgBox("Clear the existing Data sheet before importing?", _
    vbYesNo, "Clear Database?") = vbYes Then
        wsMstr.UsedRange.ClearContents
        NextCol = 1
Else
        NextCol = wsMstr.Cells(6, Columns.Count).End(xlToLeft).Column + 2
End If

Application.ScreenUpdating = False  'speed up macro

fCSV = Dir(fPath & "*.csv")         'start the CSV file listing

    Do While Len(fCSV) > 0
      'open a CSV file
        Set wbCSV = Workbooks.Open(fPath & fCSV)
      'copy data into master sheet and close source file
        ActiveSheet.UsedRange.Copy wsMstr.Cells(3, NextCol)
        wbCSV.Close False
      'read next CSV
        fCSV = Dir
        NextCol = wsMstr.Cells(6, Columns.Count).End(xlToLeft).Column + 1
    Loop

Sheets("Menu").Select

Application.ScreenUpdating = True

MsgBox "Data Import completed"

End Sub

Mon Problème: 

La macro fonctionne parfaitement et fait le travail demandé. Par contre l'ordre d'import des fichiers me pause problème. En effet au-delà de 10 fichiers importés, Excel les traitent dans l'ordre suivant: 1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 2, 20, 21 ... alors qu'évidement je cherche à avoir 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, ...

Voilà si jamais un des talentueux membres du forum a une piste, je suis preneur ;).

Merci d'avance,

Fabrice

Bonsoir FabriceR,

Je pense que tu ne nous as pas tout dit sur les noms exactes de ces fichiers CSV.

Ils sont numérotés OK, mais, à la vue de ton code j'ai bien l'impression qu'il n'y a pas qu'un numéro et ça me semble important là.

Peux tu nous citer les noms exactes, disons pour les 12 premiers...

Ensuite, si ce n'est pas confidentiel, tu peux aussi joindre un exemplaire d'un  CSV en question (zippé pour le poster ici).

Bien cordialement,

Bonjour myDearFriend,

Merci pour la réponse.

Et pourtant si, les noms de csv ne sont que des numéros croissant, incrémenté en 1. Ce qui nous donne pour les 12 premiers: 1, 2, 3, 4, 5, 6, 7, 8, 8, 10, 11, 12

Et ainsi de suite.

Pour ce qui concerne le csv en exemple, je vais en altérer un manuellement et je le posterai plus tard dans la journée.

Cordialement,

Bonjour FabriceR, le Forum,

OK, mauvaise interprétation de ma part concernant le nom des CSV.

Par ailleurs, tu n'as finalement pas besoin de joindre un exemplaire de fichier CSV et je te propose la procédure suivante pour Test :

Sub Import_Data_Click()
Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet
Dim vTabCSV() As String
Dim fPath As String, fCSV As String, FilesInPath As String
Dim NextCol As Long, nCSVmax As Long, nCSV As Long

    Set wsMstr = ThisWorkbook.Sheets("Data")
    fPath = Worksheets("Menu").Cells(4, 1).Value   'path to CSV files
    
    'Add a backslash at the end if the user forget it
    If Right(fPath, 1) <> "" Then
        fPath = fPath & ""
    End If
    
    'If there are no CSV files in the folder exit the sub
    FilesInPath = Dir(fPath & "*.csv")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If
    
    If MsgBox("Clear the existing Data sheet before importing?", _
            vbYesNo, "Clear Database?") = vbYes Then
        wsMstr.UsedRange.ClearContents
        NextCol = 1
    Else
        NextCol = wsMstr.Cells(6, Columns.Count).End(xlToLeft).Column + 2
    End If
    
    Application.ScreenUpdating = False  'speed up macro
    
    'start the CSV file listing (sort by number)
    fCSV = Dir(fPath & "*.csv")
    Do
        nCSV = Val(fCSV)
        If nCSV > 0 Then
            nCSVmax = Application.Max(nCSVmax, nCSV)
            ReDim Preserve vTabCSV(1 To nCSVmax)
            vTabCSV(nCSV) = fCSV
        End If
        fCSV = Dir
    Loop Until fCSV = ""
    
    'Store CSV datas
    For nCSV = 1 To UBound(vTabCSV, 1)
        If vTabCSV(nCSV) <> "" Then
            'open a CSV file
              Set wbCSV = Workbooks.Open(fPath & vTabCSV(nCSV))
            'copy data into master sheet and close source file
              wbCSV.Sheets(1).UsedRange.Copy wsMstr.Cells(3, NextCol)
              wbCSV.Close False
              NextCol = wsMstr.Cells(6, Columns.Count).End(xlToLeft).Column + 1
        End If
    Next nCSV
    
    Sheets("Menu").Select
    Application.ScreenUpdating = True
    MsgBox "Data Import completed"
End Sub

En espérant que ça puisse répondre à ton problème...

Bien cordialement,

Bonjour Didier, le forum,

Ta solution fonctionne très très bien.

Si j'ai bien compris, car je ne suis pas un familier de leur utilisation. Tu gères un tableau de dimensions variables dans VBA dans lequel tu listes les fichiers dans l'ordre croissant et ensuite tu forces l'import des fichiers selon ce tableau.

En tout cas merci bcp.

Fabrice

Bonjour FabriceR,

Tu as tout compris ! C'est bien ça.

Bien cordialement,