XL 2010 importer plusieurs fichier txt dans le même classeur

[jojo2006]

Bonjour à tous,

je souhaiterai réaliser une macro vba pour importer plusieurs fichiers fichiers txt dans un classeur excel
à partir d'une fenêtre où je sélectionne tous mes fichiers txt.

j'ai fais un enregistrement pour importer 1 fichier et j'obtiens le code suivant.

Pouvez vous me dire comment boucler pour le code ci dessous s'adapte avec les noms des fichiers sélectionnés (jamais identiques) et pour que les données soient copiées les unes à la suite des autres en ligne ?

je vous remercie d'avance pour votre aide.

Sub import1()
'
' import1 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\moi\Desktop\V1.0P_1_chr.txt" _
        , Destination:=Range("$A$1"))
        .Name = "A20994_CTRL_LAMAGE_V1.0P_1_chr"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

 

[Hasco]

Bonjour,

Voici une macro simple qui fonctionnera si tous vos fichiers ont la même structure. Une feuille est créée par importation.
La macro Importer n'est que très lègèrement modifiée

Sub Fichiers_Imports_multiple()
    Dim Fichiers As Variant
    Dim I As Integer

    Fichiers = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", Title:="Sélection un ou des Fichier(s)", MultiSelect:=True)

    If IsArray(Fichiers) Then
        For I = 1 To UBound(Fichiers)
            Importer Fichiers(I)
        Next
    End If
End Sub

Avec Power Query (en addOn gratuit pour 2010) vous pourriez plus facilement manipuler et transformer vos fichier.

Download Microsoft Power Query pour Excel from Official Microsoft Download Center

Microsoft Power Query pour Excel est un complément Excel qui améliore l'expérience du décisionnel libre-service dans Excel en simplifiant la récupération des données, l'accès et la collaboration.

www.microsoft.com

Cordialement

 

[jojo2006]

Bonjour Hasco,

c'est très bien cette petite macro je l'ai testé ça marche bien.🙂

Merci beaucoup !!!

ceci dit, je souhaiterait que les données de chaque fichier soit sur une feuille unique .

J'ai au moins 300 fichiers à importer donc cette solution qui crée des feuilles à chaque fichier n'est pas pertinente pour mon objectif d'analyse.

Dans la macro importer() au lieu de créer une feuill à chaque fois

' Création d'une nouvelle feuille
Set ws = ThisWorkbook.Sheets.Add()

, on reste sur la feuille de destination ( par exemple "data") et on change le range de la destination

 With ws.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ws.Range("$A$1"))

du coup j'ai modifié ton code pour avoir celà.

ce n'est pas optimal ( recherche de la derniere ligne à chaque fichier importé) mais ça marche.

il faut juste que je trouve comment ne pas importer l'entête de chaque fichier.
sinon je fais une autre macro pour épurer en fin d'importation.

Vos avis ?

merci à tous

Sub Importer(ByVal fichier As String, Optional NomDuTableau As String)
'Dim ws As Worksheet
'
' Si fichier inexistant alors sortir
If Dir(fichier) = "" Then Exit Sub
'
' Création d'une nouvelle feuille
'Set ws = ThisWorkbook.Sheets.Add()
'

Dim i As Integer

i = 1

'cherche la dernière ligne sur la feuille "data"

Sheets("data").Select

Do While Cells(i, 1).Value <> ""

i = i + 1
Loop

   
      With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=Range(Cells(i, 1), Cells(i, 1)))
   
   
        If NomDuTableau <> "" Then .Name = NomDuTableau
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

 

[Hasco]

Re,

Vous avez 2 propriétés :
1 - FieldNames mettez la à true 'Ne considèrera pas la première ligne de données comme entête
2 - TextFileStartRow mettez la à 2 ' Les données seront importées à partir de cette ligne

Et cela devrait le faire

'cherche la dernière ligne sur la feuille "data"

Sheets("data").Select

Do While Cells(i, 1).Value <> ""

i = i + 1
Loop

Oh !!! ben c'est vous qui n'avez pas beaucoup chercher. C'est une des premières demandes de tous les forum vba excel !!!!

Première ligne non occupée de Datas en colonne 1:

Dim C as range 'en tête de macro

Set C = Sheets("Data").Cells(Rows.Count, 1).End(xlUp)(2)

et ensuite : QueryTables.Add (...., Destination:= C)

cordialement

 

[Staple1600]

Bonjour le fil

Hasco (salutations 😉)
D'après le site de Microsoft, il faut un Excel 2010 Pro.
Pour 2013, peut importe la version (j'en suis témoin)
Je ne sais si il y a des XLDnautes qui ont tenté l'installation sur XL 2010 Home ou Etudiant avec succès.

NB: Au taf, ma DSN me l'avait installé sur un XL 2010 PRO
Heureusement en 2022, nous sommes passé à Office 2019 (tout en restant avec 2010 sous Citrix !!!)

 

[Hasco]

il faut un Excel 2010 Pro.

Hello l'ami,

Je ne connaissais pas cette restriction, d'autant que je l'avais installée sur mon ex version 2010 qui n'était pas Pro du tout. Faux que j'aille revoir la page de téléchargement.

Cordialement

 

[Staple1600]

Re

Hasco
J'avais espéré que tu me contredises mais...

Les versions d'Office suivantes sont prises en charge :
Microsoft Office 2010 Professional Plus avec Software Assurance
Microsoft Office 2013

NB: Ou alors cela veut dire qu'en douce, Microsoft nous incite à upgrader notre Office.
C'est pourtant pas leur genre. 😉

 

[johanvba]

Bonjour à tous;

dans ce cas, je veux importer les fichiers séparément dans différente feuille
merci.

Option Explicit

Sub Fichiers_Imports_multiple()
    Dim Fichiers As Variant
    Dim I As Integer

    Fichiers = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", Title:="Sélection un ou des Fichier(s)", MultiSelect:=False)

    If IsArray(Fichiers) Then
        For I = 1 To UBound(Fichiers)
            Importer Fichiers(I)
        Next
    End If
End Sub
Sub Importer(ByVal fichier As String, Optional NomDuTableau As String)
Dim ws As Worksheet
Dim TXT As String
Dim d As String
Dim AddInName As String
'
' Si fichier inexistant alors sortir
If Dir(fichier) = "" Then Exit Sub
'
' Création d'une nouvelle feuille
AddInName = "Etalonnage de Volume"
TXT = ThisWorkbook.Path & "\" & AddInName & ".txt"
If TXT = "fichier" Then
d = "Etalonnage de Volume"
Else
d = "Etalonnage de Pression"
End If
Set ws = ThisWorkbook.Sheets(d)
'
    With ws.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ws.Range("$A$1"))
        If NomDuTableau <> "" Then .Name = NomDuTableau
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

 

[Hasco]

Bonjour,

@johanvba : créez votre propre discussion plutôt que de squatter ce fil, qui ne répond pas à votre besoin, d'autant qu'il semble que vous utilisiez excel 2016 et non 2010.
Dans votre nouvelle discussion décrivez plus précisement votre besoin.

 

[Staple1600]

Bonjour le fil


@Hasco (salute 😉 )
Le fil est déjà créé
J'y ai même pondu un petit peu de VBA...

XL 2016 - Placer des données dans un fichier Excel avec un code VBA

Bonjour à tous; Comment lire à partir d'un fichier texte (.txt) avec son index et placer des données dans un fichier Excel . voici le code mais n'est pas marché. Sub Copy_TXT() Dim TXT_File As String Dim AddInName As String AddInName = "PPR" TXT_File = ThisWorkbook.Path & "\" & AddInName &...

www.excel-downloads.com