Discussion :

[maxicobra]

Bonjour,

Je but vraiment sur ce type de macro, qui est d'ouvrir un dossier avec plusieurs fichiers (ayant des noms non identique en .txt) et copier le contenu l'n à la suite de l'autre.
J'ai trouvé cette macro, mais ça copie pas ce que je veux, j'arrive pas à voir où est ce "paramétrage"..
Quelqu'un peut m'éclairer? merci

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
60
61
62
63
64
65
66
67
Dim wbRecap As Workbook         'fichier recap
Dim wsRecap As Worksheet        'feuille où on écrit les données
Dim wbSource As Workbook        'fichier à ouvrir
Dim wsSource As Worksheet       'feuille où on cherche les données
Dim DernLign As Integer         'ligne où on écrit les données
Dim vFichiers As Variant        'noms des fichiers
Dim i As Integer, k As Integer
Dim rgRecap As Range            'plage où on copie les données
 
Set wbRecap = ThisWorkbook       'Fichier récapitulatif
Set wsRecap = wbRecap.Sheets(1)  'on écrit dans la feuille 1 du fichier récapitulatif
 
' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
    vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers
 
' --- Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
        Debug.Print "Aucun fichier sélectionné."
        MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next
 
    Application.ScreenUpdating = False
 
' --- Boucle à travers les fichiers
For k = 1 To UBound(vFichiers)
        Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)
 
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' C'est ici qu'on écrit les instructions
Set wbSource = Workbooks.Open(vFichiers(k))                        'on ouvre le fichier
Set wsSource = wbSource.Sheets(1)                                  'On copie les données de la feuille 1
 
        DernLign = wbRecap.Sheets(1).Range("A60000").End(xlUp).Row + 1     'ligne pour écrire le log des fichiers compilés
 
' - On copie les données vers le fichier Recapitulatif; à adapter
Set rgRecap = wsRecap.Range("A9:Y1208").Offset(1, 0)
        rgRecap = Time
With wsSource
            rgRecap.Offset(0, 1) = .Range("B7")
            rgRecap.Offset(0, 2) = .Range("B8")
            rgRecap.Offset(0, 3) = .Range("B10")
            rgRecap.Offset(0, 4) = .Range("B13")
            rgRecap.Offset(0, 10) = .Range("B15")
End With
 
        wbSource.Close              'fermer fichier
Set wbSource = Nothing
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Next k
 
    Application.ScreenUpdating = True
    Application.StatusBar = False
 
End Sub
 
 
 
 
Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean
 
    sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
    bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
    Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function

[Invité]

Bonjour,

Le filtre n'est pas adpaté aux fichiers txt ainsi que l'ouverture des fichiers.

Ci-dessous, un code possible à adapter pour l'ouverture des fichiers .txt.

Pour vos fichiers .txt, il vous faut d'abord créer une macro avec l'enregistreur de macro pour voir les paramètres à modifier (données délimitées, largeur fixe et définir les séparateurs de champs).

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 
Option Explicit
 
Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean
 
    sFiltre = "Fichiers (*.txt), *.txt"
    bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
    Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
 
End Function
 
 
Sub Essai()
 
Dim WbRecap As Workbook         'fichier recap
Dim ShRecap As Worksheet        'feuille où on écrit les données
Dim DerniereLigneRecap As Long  'ligne où on écrit les données
 
Dim ShSource As Worksheet       'feuille où on cherche les données
 
Dim K As Long
 
Dim vFichiers As Variant        'noms des fichiers
 
    Set WbRecap = ThisWorkbook       'Fichier récapitulatif
    Set ShRecap = WbRecap.Sheets(1)  'on écrit dans la feuille 1 du fichier récapitulatif
 
    ' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
        vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers
 
    ' --- Vérifier qu'au moins un fichier à été sélectionné
    If Not IsArray(vFichiers) Then
            Debug.Print "Aucun fichier sélectionné."
            MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
            Exit Sub
    End If
 
    '   Application.ScreenUpdating = False
 
    ' --- Boucle à travers les fichiers
    For K = LBound(vFichiers) To UBound(vFichiers)
 
        With ShRecap
 
             DerniereLigneRecap = .Cells(.Rows.Count, 1).End(xlUp).Row + 1   'ligne pour écrire le log des fichiers compilés
 
            ' Application.StatusBar = ">> Lecture du fichier #" & K & "/" & UBound(vFichiers)
 
            OuvertureFichierTexte (vFichiers(K))  'on ouvre le fichier
            Set ShSource = ActiveSheet            'On copie les données de la feuille 1
            With ShSource
                .UsedRange.Copy Destination:=ShRecap.Cells(DerniereLigneRecap, 1) ' A adapter
            End With
            ActiveWorkbook.Close savechanges:=False 'fermer fichier
            Set ShSource = Nothing
 
        End With
 
    Next K
 
 
    Set ShRecap = Nothing
    Set WbRecap = Nothing
 
 
   '     Application.ScreenUpdating = True
    '    Application.StatusBar = False
 
End Sub
 
Sub OuvertureFichierTexte(ByVal CheminEtNomDuFichierTxt As String)
 
  ' Pour obtenir la bonne syntaxe du fichier texte à ouvrir, faire d'abord l'essai avec l'enregistreur de macro et modifier les paramètres
 
    Workbooks.OpenText Filename:=CheminEtNomDuFichierTxt _
        , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
        Comma:=True, Space:=False, 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), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
        28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
        Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
        41, 1)), TrailingMinusNumbers:=True
End Sub

Cordialement.

[patricktoulon]

Bonjour

voila une macro que j'ai faite il n'y a pas longtemps pour un autre demandeur avec la même demande
cet exemple n'ouvre pas les fichiers physiquement il les ouvre en mémoire et les compile dans un nouveau fichier

et l'ouvre a la fin
capable de compiler 300 fichiers en moins de 2 secondes

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
Sub compil_csv()
    Dim fichier_final, fichier, x, x2, chemin
    fichier_final = "C:\Users\" & Environ("UserName") & "\Desktop\Fichierfinal.csv"
    If Dir(fichier_final) <> "" Then Kill fichier_final
    chemin = ThisWorkbook.Path
    fichier = Dir(ThisWorkbook.Path & "\*.csv")
    i = 0
    Do
        x = FreeFile
        Open chemin & "\" & fichier For Input As #x
        laChaine = Input(LOF(x), #x)
        Close #x
        x2 = FreeFile
        Open fichier_final For Append As #x2
        Print #x, laChaine & vbCrLf ' si vous; voulez; pas une ligne vide entre chaque fichier; suprimer le  "& vbcrlf"
        Close #x
        i = i + 1
        fichier = Dir
    Loop Until fichier = ""
    Workbooks.Open fichier_final, local:=True
End Sub

[maxicobra]

merci beaucoup, je vais essayer ça rapidement.

Merci

[Slooby]

Bonjour

voila une macro que j'ai faite il n'y a pas longtemps pour un autre demandeur avec la même demande
cet exemple n'ouvre pas les fichiers physiquement il les ouvre en mémoire et les compile dans un nouveau fichier

et l'ouvre a la fin
capable de compiler 300 fichiers en moins de 2 secondes

Hello Patricktoulon,

Ton code est super sympa, mais il a quelques soucis dedans.
Je me suis permis de le mettre à jour:

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
Sub compil_csv()
    ' Créé par: Patricktoulon
    ' Modifié par: Slooby
 
    Dim nom_final As String
 
    Dim fichier_final As String
    Dim fichier As String
    Dim x As Variant
    Dim x2 As Variant
    Dim chemin As String
 
    ' on déclare TOUTES les variables :-)
    Dim i As Long
    Dim laChaine As String
 
    chemin = "C:\Users\ut26ca\Documents\"
    nom_final = "final_test_slooby.csv"
 
    fichier_final = chemin & nom_final
    If Dir(fichier_final) <> "" Then Kill fichier_final
 
    fichier = Dir(chemin & "*.csv")
    i = 0
 
    Do
        x = FreeFile
        Open chemin & fichier For Input As #x
        laChaine = Input(LOF(x), #x)
        Close #x
        x2 = FreeFile
        Open fichier_final For Append As #x2
        Print #x, laChaine & vbCrLf
        Close #x
        i = i + 1
        fichier = Dir
 
        'nouvelle condition: on ne prend pas dans la boucle notre classeur final
        If fichier = nom_final Then fichier = Dir
 
    Loop Until fichier = ""
 
    Workbooks.Open fichier_final, local:=True
 
End Sub

En effet, dans ton code, supposons qu'on veut ouvrir le classeur1 et classeur2 dans le classeur3, dans ce cas dans ta boucle tu vas ecrire dans classeur3 les donnees de classeur1, puis de classeur2; et là ta boucle vient prendre les donnees de classeur3 pour les remettre dans classeur3.
Tu as duplication du code.
Tu vois ce que je veux dire ?

J'ai donc rajouté un test dans la boucle pour éviter cette erreur.

Bonne journée

Slooby

[patricktoulon]

bonsoir stooby

Ton code est super sympa, mais il a quelques soucis dedans.
Je me suis permis de le mettre à jour:

non il n'avais pas de soucis le chemin du final était différent
dis plutôt que tu l'adapté a ton besoins en effet si le final doit être dans le même dossier

attention avec ta condition pour le dir fichier des fois ca déraille

met plutôt ta condition sur le open fichier c'est plus sur !!
a+