Exporter plusieurs .Csv en fonction de différentes valeurs

Version imprimable

1 pièce(s) jointe(s)

Bonjour à toutes et à tous, j'appelle a vos connaissances....

Je réalise une macro pour automatiser l'export de différentes données en plusieurs CSV.

J'ai réussi a créer ma macro pour l'import des données, le traitement de celles-ci, etc...
Maintenant vient le moment de l'export et c'est la ou je coince ::( ::(
Comme vous pouvez le voir en PJ, il y a plusieurs type de données ( maximum 10 différentes) dans la colonne A : BT, HT, EU, EP.... Mon but est de faire un CSV pour chaque type de données.
Pour l'instant, j'ai réussi a faire l'export en CSV de toute la feuille, mais je n'arrive pas a exporter un CSV pour chaque type de données...

En vous remerciant par avance

Jujudeo
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 Sub Exporter() 'copie sauvegarde rapport Application.ScreenUpdating = False Dim nom, chemin As String nom = InputBox("Nom du fichier ?", "nom") chemincsv = ThisWorkbook.Path & "\Export\" & nom & ".csv" rep = MsgBox("La feuille excel a été exportée sous : " & nom) Worksheets("Feuil1").Select Dim Plage As Object, oL As Object, oC As Object, Tmp As String, Sep$ Sep = ";" Set Plage = ActiveSheet.Range("A1:AH" & ActiveSheet.Range("A65000").End(3).Row) Open chemincsv For Output As #1 For Each oL In Plage.Rows Tmp = "" For Each oC In oL.Cells Tmp = Tmp & CStr(oC.Text) & Sep Next Print #1, Tmp Next Close Application.DisplayAlerts = False End Sub

20/10/2018, 10h49
Invité

Citation:

Envoyé par jujudeo

Bonjour,

Il vous faut créer une table sans doublons de vos dix types et faire une première boucle à partir de cette table. Chaque item de la boucle lancera chaque fois votre procédure Exporter. Il faudra bien sur enlever l'InputBox de celle-ci. Le plus simple serait de mettre votre type en paramètre de lancement d'Exporter.
20/10/2018, 11h00
jujudeo

bonjour,

Si je comprends bien, je dois créer une feuille supplémentaire "TABLES" avec mes 10 types ! Mais l'histoire de la boucle j'ai du mal a comprendre... ou du moins a traduire en vba...

Citation:

Envoyé par jujudeo

Soit une table des types nommée "TableDesTypes" dans un onglet "Paramètres"

Pièce jointe 420802

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
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
 
Option Explicit
 
 
Sub BouclerSurLaTableDesTypes()
 
Dim AireDesTypes As Range, CelluleDesTypes As Range
Dim AireDesDonnees As Range, CelluleDesDonnees As Range
Dim DerniereColonne As Long, DerniereLigne As Long
Dim Chemin As String
 
    Chemin = ThisWorkbook.Path & "\Export"
  ' Chemin = ThisWorkbook.Path
 
   Set AireDesTypes = Sheets("Paramètres").ListObjects("TableDesTypes").DataBodyRange
 
   With Sheets("Feuil1")
        DerniereColonne = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set AireDesDonnees = .Range(.Cells(1, 1), .Cells(DerniereLigne, 1))
   End With
 
   Application.ScreenUpdating = False
   For Each CelluleDesTypes In AireDesTypes
       Exporter2 AireDesDonnees, CelluleDesTypes, Chemin
   Next CelluleDesTypes
   Application.DisplayAlerts = False
 
 
   Set AireDesTypes = Nothing
   Set AireDesDonnees = Nothing
 
 
End Sub
 
 
 
Sub Exporter2(ByVal Airedesdonnees2 As Range, ByVal TypeChoisi As String, Chemin2 As String) 'copie sauvegarde rapport
 
Dim CheminCsv As String
Dim Plage As Range, oL As Range, oC As Range
Dim Tmp As String, Sep As String
 
        CheminCsv = Chemin2 & "\" & TypeChoisi & ".csv"
 
        Sep = ";"
        Open CheminCsv For Output As #1
 
        ' Copie de la ligne de titre
        Tmp = ""
        Set Plage = Range(Airedesdonnees2(1), Airedesdonnees2(1).Offset(0, 6))
        For Each oC In Plage
            Tmp = Tmp & CStr(oC.Text) & Sep
        Next oC
        Print #1, Tmp
        Set Plage = Nothing
 
 
        For Each oL In Airedesdonnees2
            Tmp = ""
            If oL = TypeChoisi Then
               Set Plage = Range(oL, oL.Offset(0, 6))
               For Each oC In Plage
                   Tmp = Tmp & CStr(oC.Text) & Sep
               Next oC
               Print #1, Tmp
               Set Plage = Nothing
 
            End If
        Next oL
        Close
 
End Sub

20/10/2018, 12h22
jujudeo

l'idée de la table des types me plait beaucoup car je peux modifier par la suite si j'ai besoin !

mais il me sort le message d'erreur " impossible d’exécuter la macro "....". Il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactivées" quand je mets votre code ! et si je remplace par le mien cela marche donc mes macros sont activées...
20/10/2018, 13h08
Invité

Citation:

Envoyé par jujudeo

Modifier le chemin.
20/10/2018, 14h10
jujudeo

En bataillant j'ai trouvé le BUG !! en tout cas, cela marche parfaitement merci beaucoup !!! :lol::lol::lol:

Bonjour, je reviens a la charge sur cette discussion car j'ai un petit soucis que je n'arrive pas a régler. En effet, la table des paramètres est top car je peux la modifier pour rajouter ou non des valeurs. Cependant, a chaque fois, il exporte tous les paramètres c'est a dire il me fait un fichier CSV pour les 10 ! alors que la plus part du temps il y en a que 5/6 ou il y aura des valeurs dans le CSV.

Je cherche donc un moyen pour que si un paramètre aura une valeur alors il exporte un csv de ce paramètre, sinon il ne le crée pas. Quelque chose du genre

Code:

If Sheets("Feuil1").Range("A" & ligne).Value = "BT" Or "FT" Or "EU" Or "EP" Or "AE" Or "FO" Or "GA" Or "HT" Or "EC" Or "IN" Or "RF" Or "AC" Then

il exporte un CSV avec ce parametre...

Mais je ne sais pas ou le mettre dans la macro qui est celle ci :

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
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
Public i, ligne As Integer
Public derligne, premligne As Long
'detection IC
 
Sub Importdonnées()
 
' Bouton import des données
'
UserForm2.Show
 
End Sub
Sub runtimeTopo()
On Error Resume Next
Sheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = "Infos Points Topo"
derligne = Sheets("TABLE Points TOPO").Range("A1048576").End(xlUp).Row
premligne = Sheets("Infos Points Topo").Range("A1048576").End(xlUp).Row
 
For i = 2 To derligne
 
ligne = i + premligne - 1
 
Sheets("Infos Points Topo").Rows(ligne + 1).Insert
 
Call pointsTopo
 
Next
 
End Sub
Sub pointsTopo() '
 
' pointsTopo
'
Sheets("Infos Points Topo").Range("A" & ligne).Value = Sheets("TABLE Points TOPO").Range("A" & i).Value
Sheets("Infos Points Topo").Range("A1").Value = "N°"
 
Sheets("Infos Points Topo").Range("B" & ligne).Value = UCase(Mid(Sheets("TABLE Points TOPO").Range("C" & i).Value, 1, 2))
Sheets("Infos Points Topo").Range("B1").Value = "Type"
 
Sheets("Infos Points Topo").Range("C" & ligne).Value = Mid(Sheets("TABLE Points TOPO").Range("C" & i).Value, 3, 4)
Sheets("Infos Points Topo").Range("C1").Value = "Profondeur"
 
Sheets("Infos Points Topo").Range("D" & ligne).Value = Sheets("TABLE Points TOPO").Range("F" & i).Value
Sheets("Infos Points Topo").Range("D1").Value = "X"
 
Sheets("Infos Points Topo").Range("E" & ligne).Value = Sheets("TABLE Points TOPO").Range("G" & i).Value
Sheets("Infos Points Topo").Range("E1").Value = "Y"
 
Sheets("Infos Points Topo").Range("F" & ligne).Value = Sheets("TABLE Points TOPO").Range("H" & i).Value
Sheets("Infos Points Topo").Range("F1").Value = "Z"
 
'Colonne numéro'
Sheets("Feuil1").Range("B" & ligne).Value = Sheets("Infos Points Topo").Range("A" & i).Value
 
'Colonne Type'
Sheets("Feuil1").Range("A" & ligne).Value = Sheets("Infos Points Topo").Range("B" & i).Value
 
'Colonne X'
Sheets("Feuil1").Range("C" & ligne).Value = Round(WorksheetFunction.VLookup(Sheets("Feuil1").Range("B" & ligne).Value, Sheets("Infos Points Topo").Range("A1:Z2000"), 4, False), 3)
'Colonne Y'
Sheets("Feuil1").Range("D" & ligne).Value = Round(WorksheetFunction.VLookup(Sheets("Feuil1").Range("B" & ligne).Value, Sheets("Infos Points Topo").Range("A1:Z2000"), 5, False), 3)
 
'Colonne ZT'
Sheets("Feuil1").Range("E" & ligne).Value = Round(WorksheetFunction.VLookup(Sheets("Feuil1").Range("B" & ligne).Value, Sheets("Infos Points Topo").Range("A1:Z2000"), 6, False), 3)
 
'Colonne Profondeur'
Sheets("Feuil1").Range("G" & ligne).Value = WorksheetFunction.VLookup(Sheets("Feuil1").Range("B" & ligne).Value, Sheets("Infos Points Topo").Range("A1:Z2000"), 3, False)
 
 
End Sub
 
 
Sub BouclerSurLaTableDesTypes()
 
Dim AireDesTypes As Range, CelluleDesTypes As Range
Dim AireDesDonnees As Range, CelluleDesDonnees As Range
Dim DerniereColonne As Long, DerniereLigne As Long
Dim Chemin As String
 
    Chemin = ThisWorkbook.Path & "\Export"
  ' Chemin = ThisWorkbook.Path
   Set AireDesTypes = Sheets("Paramètres").ListObjects("TableDesTypes").DataBodyRange
 
   With Sheets("Feuil1")
        DerniereColonne = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set AireDesDonnees = .Range(.Cells(1, 1), .Cells(DerniereLigne, 1))
   End With
 
 
   Application.ScreenUpdating = False
   For Each CelluleDesTypes In AireDesTypes
       Exporter2 AireDesDonnees, CelluleDesTypes, Chemin
   Next CelluleDesTypes
   Application.DisplayAlerts = False
 
   Set AireDesTypes = Nothing
   Set AireDesDonnees = Nothing
 
 
 
End Sub
 
 
 
Sub Exporter2(ByVal Airedesdonnees2 As Range, ByVal TypeChoisi As String, Chemin2 As String) 'copie sauvegarde rapport
 
Dim CheminCsv As String
Dim Plage As Range, oL As Range, oC As Range
Dim Tmp As String, Sep As String
 
        CheminCsv = Chemin2 & "\" & TypeChoisi & ".csv"
 
        Sep = ";"
        Open CheminCsv For Output As #1
 
        ' Copie de la ligne de titre
        Tmp = ""
        Set Plage = Range(Airedesdonnees2(1), Airedesdonnees2(1).Offset(0, 6))
        For Each oC In Plage
            Tmp = Tmp & CStr(oC.Text) & Sep
        Next oC
        Print #1, Tmp
        Set Plage = Nothing
 
 
        For Each oL In Airedesdonnees2
            Tmp = ""
            If oL = TypeChoisi Then
               Set Plage = Range(oL, oL.Offset(0, 6))
               For Each oC In Plage
                   Tmp = Tmp & CStr(oC.Text) & Sep
               Next oC
               Print #1, Tmp
               Set Plage = Nothing
 
            End If
        Next oL
        Close
 
End Sub

Je vous remercie par avance

Jujudeo

Citation:

Envoyé par jujudeo

Bonjour,

Il suffirait d'ajouter une colonne dans la table des types et d'y mettre cette formule :
Pièce jointe 498320

Puis de modifier la procédure (C'est celle de ma dernière réponse et non le vôtre) :

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
 
Sub BouclerSurLaTableDesTypes()
 
Dim AireDesTypes As Range, CelluleDesTypes As Range
Dim AireDesDonnees As Range, CelluleDesDonnees As Range
Dim DerniereColonne As Long, DerniereLigne As Long
Dim Chemin As String
 
    Chemin = ThisWorkbook.Path & "\Export"
  ' Chemin = ThisWorkbook.Path
 
   Set AireDesTypes = Sheets("Paramètres").ListObjects("TableDesTypes").DataBodyRange
 
   With Sheets("Feuil1")
        DerniereColonne = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set AireDesDonnees = .Range(.Cells(1, 1), .Cells(DerniereLigne, 1))
   End With
 
   Application.ScreenUpdating = False
   For Each CelluleDesTypes In AireDesTypes
       If CelluleDesTypes.Offset(0, 1) > 0 Then
          Exporter2 AireDesDonnees, CelluleDesTypes, Chemin
       End If
   Next CelluleDesTypes
   Application.DisplayAlerts = False
 
 
   Set AireDesTypes = Nothing
   Set AireDesDonnees = Nothing
 
End Sub

20/08/2019, 09h03
jujudeo

bonjour,

Cela marche très très bien je vous remercie beaucoup !