Consolidation et conversion en boucle fichier Txt dans Excel

Version imprimable

Bonjour à tous

Je souhaites via un code VBA aller sélectionner des fichiers .txt et qu'ils soient convertis et consolidés dans un même onglets sachant que le séparateur des fichier .txt est ";"

Je n'arrive pas à trouver comment intergrer ce code permettant de convertir mes fichiers Txt avec un separateur ";" au reste du code

Code:

1
2
 Workbooks.OpenText Filename:=Fichiers(i), Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Semicolon:=True

Voici le reste du code.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub Importer()
    Dim dlDest As Long, dlSource As Long, dlgR As Long, i As Long
    Dim Chemin As String
    Dim fichier As Variant, Fichiers As Variant
    Dim Wb As Workbook
 
    Application.ScreenUpdating = False
 
'efface les données de l'onglet DATA de la colonne A a la colonne AF sauf la premiere ligne
With ThisWorkbook.Sheets("Data")
    dlgR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A2:AF" & dlgR).ClearContents
End With
 
    'Ouvre exploreur et permet aux utilisateur de selectionner les fichiers Excel a consolider
    ChDir ThisWorkbook.Path
    Fichiers = Application.GetOpenFilename("Text Files (*.txt),*.txt", MultiSelect:=True)
    'Si aucun fichier n'est selectionné, on arrete le code
    If Not IsArray(Fichiers) Then Exit Sub
    'Pour chaque fichier selectionné
 
   For i = 1 To UBound(Fichiers)
 
        dlDest = ThisWorkbook.Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row + 1 '1ere ligne vide
        'On definit Wb qui ouvre le fichier selectionne
    '    Set Wb = Workbooks.Open(Fichiers(i))
 
        Set Wb = Workbooks.Open(Fichiers(i))
                  Workbooks.OpenText Filename:=Fichiers(i), Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Semicolon:=True
 
 
        ', Origin:=xlWindows, _
        'StartRow:=1, DataType:=xlDelimited, Semicolon:=True
        'Feuille à copier
       With Wb.ActiveSheet.Name
            'dernière ligne du fichier source
            dlSource = .Cells(.Rows.Count, "A").End(xlUp).Row
            'Copier vers la 1ere ligne non vide de la feuille Data du fichier de consolidation
            .Range("A2:AF" & dlSource).Copy ThisWorkbook.Sheets("Data").Range("A" & dlDest)
      End With
        'On ferme le fichier source ouvert
        Wb.Close False
    Next
 
    Application.ScreenUpdating = True
 
End Sub

J'ai utilisé ce code mais il y a peut être d'autres solutions, je débute dans le VBA.

Merci d'avance pour votre aide.

08/10/2017, 15h27
Docmarti

Bonour.

Fais un test avec

Code:

Set Wb = Workbooks.Open(Filename:=Fichiers(i), local:=True)
10/10/2017, 11h00
phoenix974

Ca à l'air de fonctionner mais j'ai une erreur 424 Objet requis sur la ligne:

Code:

dlSource = .Cells(.Rows.Count, 1).End(xlUp).Row
10/10/2017, 11h43
Docmarti

Ce n'est pas le nom de l'objet feuille qui t'interesse, mais l'objet feuille lui-meme.

Remplace

Code:

With Wb.ActiveSheet.Name

par

Code:

With Wb.ActiveSheet

Merci pour la précision.

Voici le code modifié qui fonctionne cette fois.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Importer()
    Dim dlDest As Long, dlSource As Long, dlgR As Long, i As Long
    Dim Chemin As String
    Dim Fichier As Variant, Fichiers As Variant
    Dim Wb As Workbook
 
    Application.ScreenUpdating = False
 
'efface les données de l'onglet GLOBAL de la colonne A a la colonne AF sauf la premiere ligne
With ThisWorkbook.Sheets("GLOBAL")
    dlgR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A2:AF" & dlgR).ClearContents
End With
 
    'Ouvre exploreur et permet aux utilisateur de selectionner les fichiers Excel a consolider
    ChDir ThisWorkbook.Path
    Fichiers = Application.GetOpenFilename("Text Files (*.txt),*.txt", MultiSelect:=True)
 
    'Si aucun fichier n'est selectionné, on arrete le code
    If Not IsArray(Fichiers) Then Exit Sub
 
    'Pour chaque fichier selectionné
    For i = 1 To UBound(Fichiers)
 
    dlDest = ThisWorkbook.Sheets("GLOBAL").Cells(Rows.Count, "A").End(xlUp).Row + 1 '1ere ligne vide
 
    'On definit Wb qui ouvre le fichier selectionne
     Set Wb = Workbooks.Open(Filename:=Fichiers(i), local:=True)
 
        'Feuille à copier
       With Wb.ActiveSheet
            'dernière ligne du fichier source
            dlSource = .Cells(.Rows.Count, 1).End(xlUp).Row - 6
            'Copier vers la 1ere ligne non vide de la feuille GLOBAL du fichier de consolidation
            .Range("A3:AF" & dlSource).Copy ThisWorkbook.Sheets("GLOBAL").Range("A" & dlDest)
      End With
        'On ferme le fichier source ouvert
        Wb.Close False
    Next
 
    Application.ScreenUpdating = True
 
End Sub

Si je veux qu'il explore tous les fichiers txt du dossier, je dois juste remplacer:

Code:

1
2
3
    'Ouvre exploreur et permet aux utilisateurs de sélectionner les fichiers Excel à consolider
    ChDir ThisWorkbook.Path
    Fichiers = Application.GetOpenFilename("Text Files (*.txt),*.txt", MultiSelect:=True)

par: ??

Code:

1
2
3
     'Répertoire contenant les fichiers
    Chemin = ThisWorkbook.Path
    Fichiers = Dir(Chemin & "\*.txt")

11/10/2017, 02h27
Docmarti

Regarde "Comment boucler sur les fichiers d'un répertoire ?" dans cette page de la FAQ

Salut, à adapter à ton contexte

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
 
Sub FusionTXTs()
Dim FSO As Object
Dim SourceFolder As Object, OutputFile As Object
Dim File As Object, TextFile As Object, sFusionTXTs As String
Dim sText As String, sNomFichier As String, sDossierTxt As String
Const ForReading = 1
 
    sDossierTxt = "....."
    sFusionTXTs = "....."
    sNomFichier = "....."
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(sDossierTxt)
    Set OutputFile = FSO.CreateTextFile(sNomFichier)
 
    For Each File In SourceFolder.Files
        Set TextFile = FSO.OpenTextFile(File, ForReading)
        sText = TextFile.ReadAll
        TextFile.Close
        OutputFile.WriteLine sText
    Next File
    OutputFile.Close
 
    Set OutputFile = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

12/10/2017, 02h19
clementmarcotte

En double

https://www.developpez.net/forums/d1...l/#post9681765
12/10/2017, 08h27
Invité

Bonjour,
https://www.developpez.net/forums/d1...u/#post9163787