Discussion :

[KekileM]

Bonjour,
je suis ingénieure stagiaire, complètement débutante en VBA et je souhaite créer une macro qui me permet d'importer plusieurs fichiers texte .XYZ qui se situent tous dans le même dossier.
J'ai trouvé une macro qui me permet de choisir le dossier où sont stockés mes fichiers et qui importe ensuite tous les fichiers dans mon classeur excel. Le problème de cette macro c'est qu'elle importe chaque fichier dans une feuille différente or je voudrais que les fichiers soit tous sur la même feuille l'un à la suite de l'autre. J'imagine qu'il faut se servir de Range("A65536").End(xlUp).Row,1 mais je ne sais pas trop comment.

J'ai ce code pour le moment qui fonctionne a moitié car j'ai juste le premier fichier qui s'importe (j'ai environ 50 autres fichiers)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
49
50
51
52
53
54
55
56
57
58
59
 
Sub on_y_va()
    Range("A1:F65536").ClearContents
 
    Dim Repertoire As FileDialog, monRepertoire As String
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        monRepertoire = Repertoire.SelectedItems(1)
        aspirer monRepertoire
    Else
        MsgBox "Aucun Répertoire Sélectionné"
    End If
End Sub
 
Sub aspirer(ceRepertoire As String)
 
    Dim Fso, SourceFolder, SubFolder, fichier As Object, Lg As Integer
    Dim ws As Worksheet, wrecap As Worksheet
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(ceRepertoire)
 
    ' boucle sur tous les fichiers du répertoire
    For Each fichier In SourceFolder.Files
        If Right(fichier.Name, 4) = ".XYZ" Then
 
            N = FreeFile
            Open fichier For Input As #N
 
            i = 0
            Do While Not EOF(1)
                Line Input #N, contenu
                i = i + 1
                Cells(i, 1).Value = contenu
            Loop
 
            Close #N
 
    Columns("A:A").Select
    On Error Resume Next
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
        TrailingMinusNumbers:=True
    Cells.Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
        End If
    Next fichier
 
End Sub

[patricktoulon]

bonjour tu n'a pas que le premier mais forcement le dernier puisque tu initialyse toujours "i" a 0
d'autre part c'est un peu lourd avec les librairie scripting

[riaolle]

Bonjour,
Une fois que tu as importé toutes les données sur plusieurs feuilles, tu peux regrouper les données sur une feuille de la façon suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub boutABout()
    Dim bilan As Worksheet
    Set bilan = Sheets(1)
    Dim feuille As Worksheet
 
    For Each feuille In ActiveWorkbook      'boucle sur l'ensemble des feuilles
        feuille.Cells.Copy      'on copie toutes les cellules de la feuille
        bilan.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial  'on colle sur la dernière ligne de la feuille bilan
    Next feuille
End Sub

[patricktoulon]

re
allez un petit exemple avec des csv vite fait a améliorer ou modifier pour le textcolumn
je n'utilise pas de sheets intermédiaire ca s'ajoute les un dessous les autres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub on_y_va()
    Dim Repertoire As FileDialog, monRepertoire As String
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        monRepertoire = Repertoire.SelectedItems(1)
        fichs = Dir(monRepertoire & "\*.csv")
        Do While fichs <> ""
            aspire CStr(monRepertoire & "\" & fichs)
            fichs = Dir
        Loop
        Columns("A:A").TextToColumns Destination:=Range("A1"), Space:=False
    Else
        MsgBox "Aucun Répertoire Sélectionné"
    End If
End Sub
 
Sub aspire(fichier)
    If Right(fichier, 4) = ".csv" Then
        N = FreeFile
        Open fichier For Input As #N
        i = Cells(Rows.Count, 1).End(xlUp).Row
        Do While Not EOF(1)
            Line Input #N, contenu
            i = i + 1
            Cells(i, 1).Value = contenu
        Loop
        Close #N
    End If
End Sub

[KekileM]

Mon problème a été résolu, merci beaucoup pour vos réponses et le temps que vous avez accordé au problème.
J'ai fini par scinder en 2 macros:
1) l'importation de tous les fichiers .XYZ les uns à la suite des autres dans la première colonne
2) le triage des différentes données de chaque ligne en plusieurs colonnes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
49
50
51
52
53
54
55
56
57
58
59
Sub on_y_va() 'ouvre une boite de dialogue qui permet de sélectionner le dossier où se trouvent les fichiers
    Range("A1:F65536").ClearContents 'supprime tout ce qui est sur la feuille active
    Dim Repertoire As FileDialog, monRepertoire As String
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        monRepertoire = Repertoire.SelectedItems(1)
        aspirer monRepertoire
    Else
        MsgBox "Aucun Répertoire Sélectionné"
    End If
End Sub
 
Sub aspirer(ceRepertoire As String) 'importe tous les fichiers les uns à la suite des autres dans la première colonne
 
    Dim Fso, SourceFolder, SubFolder, fichier As Object
    Dim ws As Worksheet, wrecap As Worksheet
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(ceRepertoire)
 
    ' boucle sur tous les fichiers du répertoire
    For Each fichier In SourceFolder.Files
        If Right(fichier.Name, 4) = ".XYZ" Then
 
            N = FreeFile
            Open fichier For Input As #N
 
         i = 0
         k = Range("A65536").End(xlUp).Row
           Do While Not EOF(1)
                Line Input #N, contenu
                i = k
                Cells(i, 1).Value = contenu
                k = k + 1
            Loop
 
            Close #N
        End If
    Next fichier
bla
 
End Sub
 
Sub bla() ' scinde et réparti les données de la première colonne sur les colonnes suivantes à chaque espace
 
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
        TrailingMinusNumbers:=True
    Cells.Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
End Sub

[riaolle]

Si tn problème est résolu, n'oublie pas de cliquer sur
Bon courage pour la suite