Rapport de message :*
 

Re: Import multiple csv

Titre du sujet : Re: Import multiple csv
par myDearFriend! le 21/02/2016 11:50:44

Bonjour FabriceR, le Forum,

 

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

 

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,