Macro pour sauvegarder des données txt en csv [Résolu]

[Vincent32]

Bonjour,

J'ai une macro qui m'importe des données :

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
'Déclarations des variables
    Dim Fso As Object
    Dim FsoRepertoire As Object
    Dim FsoFichier As Object
    Dim i As Long
    Dim c As Integer
    Dim strLigne As String
    Dim str() As String
 
    'Attribution de valeurs
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FsoRepertoire = Fso.GetFolder(Sheets("Macro").Range("E11").Value) 'nom du répertoire
 
    'Boucle sur fichiers du repertoire
    c = 2
        For Each FsoFichier In FsoRepertoire.Files
            i = 1
            'Vérifie si le fichier a l'extension souhaité
            str = Split(FsoFichier.Name, ".")
                If str(UBound(str)) = "dpt" Then
                    'ouvre le fichier
                    Open FsoFichier.Path For Input As #1
                        'Boucle sur chaque ligne du fichier
                        Do While Not EOF(1)
                            Line Input #1, strLigne
                            str = Split(strLigne, Chr(9))
                            'insere la ligne dans la cellule
                            Sheets("Données brutes").Cells(i, c).Value = str(1)
                            i = i + 1
                        Loop
                    Close #1
                    c = c + 1
                End If
        Next

Je souhaite que ces données soient sauvegarder dans un répertoire dont le chemin est indiqué dans la cellule E13 de ma feuille 1 selon fichier type csv de la manière suivante :

- fichier csv n°1 colonne A et B de la feuille 2
- fichier csv n°2 colonne A et C de la feuille 2
- ...
- fichier csv n°"x" colonne A et "x" de la feuille 2

La colonne "x" correspond à la dernière colonne comportant des données

Cordialement

Vincent

[Vincent32]

J'ai trouvé !

En adaptant un code fourni par Daniel (encore une fois merci Daniel) que j'ai inséré dans ma deuxième colonne je suis arrivé à mes fins.

Voici le code pour les curieux :

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
'Déclaration des variables
    Dim ws0 As Worksheet, ws1 As Worksheet
    Const PremC1 = 1 'Première colonne de données dans la feuille 1
    Dim DerC1 As Long 'Dernière colonne de données dans la feuille 1
    Dim Col As Long
 
    'Attribution de valeurs
    Set ws0 = Worksheets("Macro")
    Set ws1 = Worksheets("Données brutes") 'L'objet Feuille 1 est attribué à la variable ws1
 
    'Recherche de la dernière colonne renseignée dans la ligne 1 de la feuille 1
    DerC1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
 
    'Enregistrement données brutes
        For Col = PremC1 To DerC1 - 2
                    'ajout d'un classeur avec 1 feuille
                    Workbooks.Add 1
                    'copie des colonnes qui vont bien dans le nouveau classeur
                    ws1.[A:A].Copy [A1]
                    ws1.Cells(1, Col).Offset(0, 1).EntireColumn.Copy [B1]
                    'enregistrement au format csv
                    ActiveWorkbook.SaveAs ws0.[E13] & Col & ".csv", xlCSV, Local:=True
                    'fermeture du classeur texte
                    ActiveWorkbook.Close False
        Next Col

Bonne journée à tous

Vincent

[mercatog]

Bonjour
Ton code adapté pourrait être encore plus formalisé comme ceci

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
'Déclaration des variables
Const PremC1 As Byte = 1                                   'Première colonne de données dans la feuille 1
Dim Ws0 As Worksheet, Ws1 As Worksheet
Dim Wbk As Workbook
Dim DerC1 As Integer, Col As Integer
 
Application.ScreenUpdating = False
'Attribution de valeurs
Set Ws0 = Worksheets("Macro")
Set Ws1 = Worksheets("Données brutes")                     'L'objet Feuille 1 est attribué à la variable ws1
'Recherche de la dernière colonne renseignée dans la ligne 1 de la feuille 1
With Ws1
    DerC1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
    'Enregistrement données brutes
    For Col = PremC1 To DerC1 - 1
        'ajout d'un classeur avec 1 feuille
        Set Wbk = Workbooks.Add(1)
        'copie des colonnes qui vont bien dans le nouveau classeur
        Union(.Columns(1), .Columns(Col + 1)).Copy Wbk.Worksheets(1).Range("A1")
        'enregistrement au format csv
        Wbk.SaveAs Ws0.Range("E13") & Col & ".csv", xlCSV, Local:=True
        'fermeture du classeur texte
        Wbk.Close False
        Set Wbk = Nothing
    Next Col
End With
Set Ws0 = Nothing
Set Ws1 = Nothing