J'ai eu le même problème, et je voulais ajouter plusieurs (16 pour être précis) fichiers csv dans une liste. Le tableau que j'ai utilisé est statique et il existe de meilleures façons de le coder, mais j'avais besoin de collecter des fichiers spécifiques à partir d'un certain nombre de fichiers csv qui se trouvent dans l'emplacement du dossier.
J'ai trouvé votre code intéressant, et j'ai mis à jour le code que j'avais assemblé à partir d'autres sources pour obtenir un ensemble de code qui fonctionne.
Merci de partager votre code, comme vous le verrez, j'ai utilisé un élément de votre code pour trouver la prochaine ligne vide à ajouter.
Voir l'exemple de code ci-dessous, vous devrez ajouter les noms de fichiers, et le chemin d'accès au répertoire des fichiers, et mettre à jour le tableau xFiles pour qu'il corresponde au nombre de fichiers que vous souhaitez importer et ajouter :
Sub LoadDelimitedFiles()
Dim xStrPath As String
Dim xFile As String
Dim xCount As Long
Dim xFiles(15) As String
Dim destCell As Range
On Error GoTo ErrHandler
'added an update to the code to select the individual file names needed from server within a folder
'PathName of Folder Location
xStrPath = "<Insert Folder Location>"
'Name the Array with the CSV files name for file Content
xFiles(0) = "<Filename1>"
xFiles(1) = "<Filename2>"
xFiles(2) = "<Filename3>"
xFiles(3) = "<Filename4>"
xFiles(4) = "<Filename5>"
xFiles(5) = "<Filename6>"
xFiles(6) = "<Filename7>"
xFiles(7) = "<Filename8>"
xFiles(8) = "<Filename9>"
xFiles(9) = "<Filename10>"
xFiles(10) = "<Filename11>"
xFiles(11) = "<Filename12>"
xFiles(12) = "<Filename13>"
xFiles(13) = "<Filename14>"
xFiles(14) = "<Filename15>"
xFiles(15) = "<Filename16>"
xCount = 0
If xStrPath = "" Then Exit Sub
Application.ScreenUpdating = False
'Clear Existing Sheet Data
Columns("A:I").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'Set the 1st Filename
xFile = Dir(xStrPath & xFiles(xCount) & ".csv")
'destCell contains the location of the next cell to append the next csv file data to
Set destCell = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1)
Do While xCount <> 16
xFile = Dir(xStrPath & xFiles(xCount) & ".csv")
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& xStrPath & xFile, Destination:=destCell)
.Name = "a" & xCount
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
Set destCell = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1)
xCount = xCount + 1
End With
Loop
'Remove the Blank Top row
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
'Update the screen to show the contents appended csv file data
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "no files found", , "Error Message"
End Sub
