Extraire données de plusieurs fichiers TXT dans un tableau Excel unique

Bonjour,

Je m'adresse au forum car je ne trouve pas la solution à mon problème.

Je possède un dossier avec des centaines de fichiers TXT, qui possèdent chacuns des données. Les fichiers ont tous la même structure. Je sais comment construire un tableau en récupérant les données de ces fichiers grâce à Power Query.

Je voudrais cependant automatiser la manipulation via une macro afin de que n'importe quel utilisateur, même peu adepte de excel, puisse le faire. Comme selon les utilisateurs, la localisation du dossier contenant les fichiers peut-être différente, l’exécution de la macro doit permettre d'ouvrir la boite de dialogue qui permet de sélectionner la localisation du dossier. A la fin, je souhaite obtenir un tableau unique, sur un même onglet, dont chaque ligne correspond à un fichier TXT. S'il y'a 150 fichiers TXT dans mon dossier, j'aurai donc 150 lignes. Les fichiers ayant tous la même structure (tabulation pour délimiter les colonnes), ça ne pose pas de problème.

Je ne parviens pas à le faire en VBA. Auriez-vous une idée ? Je m'arrache un peu les cheveux là !

Pour l'instant, j'ai trouvé ce code sur Internet qui fait quasiment ce que je veux. Seulement, il saisie les données de chaque fichier dans un onglet différent. Au lieu d'obtenir 150 lignes, j'obtiens donc 150 onglets de 1 lignes à chaque fois. Peut-être un point de départ ?

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

Merci d'avance.

Hello,

Pourquoi ne pas rester sur PowerQuery et mettre une cellule de paramètre dans l'Excel directement, pas besoin de rentrer dans l'éditeur PowerQuery.

L'utilisateur renseigne son chemin et a juste à faire clic droit puis actualiser sur le tableau.

Ca conviendrait ?

@+

Bonjour,

Je voulais quelque chose de simple, pour les futurs utilisateurs qui ne connaissent pas PowerQuery. Ils ouvrent le fichier, clique sur un bouton, renseigne dans une boite de dialogue le dossier dans lequel sont réunis leurs fichiers .txt, et la macro s'execute. Chaque fichier .txt comprend un ligne de valeurs, séparées de tabulation. La macro les récupère et en fait une ligne dans un même tableau.

En gros j'ai trois fichiers .txt qui comprennent chacun le texte suivant :

fichier1.txt : pomme poire pêche
fichier2.txt : rouge vert jaune
fichier3.txt : petit moyen gros

La macro me crée un tableau excel qui comprend le résultat suivant :

Ainsi, si j'ai des centaines de fichiers .txt, je peut créer une base de donnée en un instant sans manipulation manuelle.

J'ai finalement trouvé une solution proposée par quelqu'un sur un forum. Cela fonctionne tres bien. Je la poste pour ceux que ça interesse. Je l'ai mise dans un module, lié à un bouton d'execution. Je précise, ce n'est pas moi qui l'ai fait ! Je suis débutant en VBA, c'est un niveau bien au dessus de ce que je sais faire.

Sub Requete_des_donnees_txt()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet

    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False

            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Merci en tout cas pour les contributions !

un alternatif :

joindre les txt files avant de l'import dans excel avec copy *.txt newfile.txt ...