Sauvegarde classeur excel selon nom de cellule à la fin de la macro

**Vincent32** · 13/01/2012, 09h37

Bonjour à tous,

Je souhaiterais qu'à la fin de ma macro mon document excel soit sauvegardé automatiquement et que le nom de la sauvegarde soit le texte contenu dans une cellule bien défini.

Merci pour votre aide, bonne journée

Cordialement

Vincent

**MarcelG** · 13/01/2012, 09h47

Bonjour,

Tu peux affecter le contenu d'une cellule à la propriété FileName de la propriété Saveas.

Regarde l'aide en ligne dans ton éditeur VBE sur ces mots-clés, et reviens si nécessaire.

**Vincent32** · 13/01/2012, 10h24

Bonjour Marcel,

En fait j'ai trouvé quelques lignes de codes dans un des tutos proposé, mais j'ai du mal à l'adapter pourrais-tu m'aider à le décrypter ?

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
 
Sub TestSave ()
 
dim MonClasseur As Workbook 'déclaration de variable
Dim ws0 As Worksheet 'Déclaration des variables
    Set ws0 = Worksheets("Macro") 'Attribution de la valeur
Dim nom as String
Set nom= ws0.[E34]'nom du fichier
 
Set MonClasseur = Application.Workbooks.Add
With MonClasseur.Worksheets (1).Cells(1, 1)
.Value=1
.resize(100).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=100, Trend:=False
End With
MonClasseur.SaveCopyAs nom".xls"'la syntaxe est correcte ?
Debug. Print MonClasseur.Saved
End Sub

Merci pour ton aide

Cordialement,

Vincent

**MarcelG** · 13/01/2012, 10h54

Salut Vincent,

La question est de savoir l'action que tu souhaites voir réalisée par ton code.
Ensuite, vient son développement.

Néammoins, quelques remarques :

- Généralement, les déclaration Dim débutent le code
- Suivent les affectations de variables aux objets par la mérhode Set
- Ces variables sont vidées en fin de code

Ex:

Code :

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

Set lavariable = Nothing

- Il ne faut pas abuser de ces affectations. Elles trouvent vraiment leur utilité dans les nombreux appels aux objets auxquels elles sont affectées.

Dans ton cas (la variable "wso" ne semble pas affectée dans ta proposition)

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
Sub TestSave()
 
Dim MonClasseur As Workbook 'déclaration de variable
Dim nom As String
 
nom = Sheets(1).[E34] 'nom du fichier
 
Set MonClasseur = Application.Workbooks.Add
 
With MonClasseur
        With .Worksheets(1).Cells(1, 1)
            .Value = 1
            .Resize(100).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=100, Trend:=False
        End With
        'Si sauvegarde d'une copie
        '.SaveCopyAs nom & ".xls"
        'Si sauvegarde du classeur actif
        .SaveAs Filename:=nom & ".xls"
End With
 
Set MonClasseur = Nothing
 
End Sub

**Golonne** · 13/01/2012, 10h54

Code :

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

MonClasseur.SaveCopyAs "nom.xls"'la syntaxe est correcte ?

Bonjour,

Regarde plutôt la méthode SaveAs plutôt que SaveCopyAs. La première va enregistrer ton fichier tandis que la seconde va créer une copie de ce dernier.

Si ta macro est attachée à ton classeur alors tu peux utiliser :

Code :

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

ThisWorkbook.SaveAs Filename:="nom.xls"

Dans l'exemple de ton tuto le programme crée une variable objet MonClasseur qui réagit comme un objet workbook.

Pour répondre à ta question initiale, si le nom de ton fichier se trouve dans une cellule, récupère la valeur de cette cellule, affecte la à une variable string et passe cette variable comme paramètre de SaveAs.

Reviens moi si je ne suis pas clair.

Cordialement,

Guillaume

Edit : Désolé Marcel je n'avais pas vu ta réponse

**Vincent32** · 13/01/2012, 12h20

Je n'ai pas encore essayé le code mais j'aimerais comprendre cette partie. Qu'est ce qu'il se passe et si j'ai plusieurs feuilles dans mon classeur ça marche également ?

Code :

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

1
2
3
4
5
With MonClasseur
        With .Worksheets(1).Cells(1, 1)
            .Value = 1
            .Resize(100).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=100, Trend:=False
        End With

Cordialement

Vincent

**MarcelG** · 13/01/2012, 12h30

Salut Vincent,

Il te suffit de balayer la collection des feuilles de travail de ton classeur

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
Public Sub essai()
 
'le code précédent
 
Dim wk As Worksheets
 
With monclasseur
        For Each wk In .Worksheets
            With wk.Cells(1, 1)
                .Value = 1
                .Resize(100).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=100, Trend:=False
            End With
            'la suite du code
        Next wk
End With
'la suite du code
 
End Sub

**Vincent32** · 16/01/2012, 10h25

Désolé mais je ne comprends toujours pas le code :

Qu'entends tu par : "le code précédent" et "la suite du code"

D'autre part j'ai du mal à saisir :

Code :

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

1
2
3
With wk.Cells(1, 1) ' pourquoi sélectionner une cellule en particulier (A1)?
                .Value = 1 'pourquoi lui attribuer une valeur ?
                .Resize(100).DataSeries Rowcol:=xlColumns, Type:=xlLinear, ' Step:=1, Stop:=100, Trend:=False'et là je ne cerne pas l'intérêt de cette ligne

Merci pour vos explications

**MarcelG** · 16/01/2012, 10h33

Le code que tu cites est le-tien.

Ne cernant pas ton besoin, je n'ai fait que d'apporter des indications qui te mettent dans la bonne voie.

Dans ces conditions, mieux vaut retourner un code que tu aurais développé et indiquer les actions que tu souhaites voir réaliser et qui posent problème.

**Vincent32** · 16/01/2012, 10h47

Bonjour Marcel,

Merci pour ta réponse. Clairement je souhaite à la fin de ma macro sauvegarder automatiquement mon classeur excel. L'emplacement de la sauvegarde est indiqué dans la cellule E9 de la feuille Macro. Le nom sous lequel le fichier doit être sauvegardé est indiqué dans la cellule E35 de la feuille intitulé Macro.

Mon code actuel réalise différentes opérations d'importations, de retraitement et de sauvegarde de données.

le voici dans son intégralité :

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
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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
Sub test() 'création répertoires
    Dim ws0 As Worksheet 'Déclaration des variables
    Set ws0 = Worksheets("Macro") 'Attribution de la valeur
    CreationRepertoire ws0.[E9], "\Retraitement" 'Exemple : CreationRepertoire "C:\Documents and Settings\dossier", "Archives" crée un dossier "Archives" dans "C:\Documents and Settings\dossier"
        CreationRepertoire ws0.[E24], "Correction ligne de base"
            CreationRepertoire ws0.[E25], "csv"
            CreationRepertoire ws0.[E25], "txt"
        CreationRepertoire ws0.[E24], "Dérivée première"
            CreationRepertoire ws0.[E26], "csv"
            CreationRepertoire ws0.[E26], "txt"
        CreationRepertoire ws0.[E24], "Dérivée seconde"
            CreationRepertoire ws0.[E27], "csv"
            CreationRepertoire ws0.[E27], "txt"
        CreationRepertoire ws0.[E24], "Données brutes"
            CreationRepertoire ws0.[E28], "csv"
            CreationRepertoire ws0.[E28], "txt"
        CreationRepertoire ws0.[E24], "N-(N-1)"
            CreationRepertoire ws0.[E29], "csv"
            CreationRepertoire ws0.[E29], "txt"
        CreationRepertoire ws0.[E24], "Soustraction"
            CreationRepertoire ws0.[E30], "csv"
            CreationRepertoire ws0.[E30], "txt"
End Sub
 
Sub CreationRepertoire(DossierParent As String, NomRep As String)
    Dim chemin As String
    If Dir(DossierParent, vbDirectory + vbHidden) <> "" Then 'Vérifie si le répertoire existe.
        'Vérifie que le dossier à créer n'existe pas déjà dans le répertoire
        If Dir(DossierParent & "\" & NomRep, vbDirectory + vbHidden) = "" Then _
            MkDir DossierParent & "\" & NomRep
    End If
End Sub
Public Function NomFichierSansExtension(nomFichier As String) As String 'suppresion de l'extension pour les noms de fichiers
    Dim p As Integer
    p = InStrRev(nomFichier, ".")
    If p > 0 Then
        NomFichierSansExtension = Mid(nomFichier, 1, p - 1)
    Else
        NomFichierSansExtension = nomFichier
    End If
End Function
Sub sup() 'suppression des données contenues dans les feuilles avant d'exécuter l'import
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet, ws6 As Worksheet 'Déclaration des variables
    Set ws1 = Worksheets("DDonnées brutes") 'Attribution de valeurL'objet Feuille 1 est attribué à la variable ws1
    Set ws2 = Worksheets("DSoustraction") 'L'objet Feuille 2 est attribué à la variable ws2
    Set ws3 = Worksheets("DCorrection ligne de base") 'L'objet Feuille 3 est attribué à la variable ws3
    Set ws4 = Worksheets("DN-(N-1)")
    Set ws5 = Worksheets("DDérivée première")
    Set ws6 = Worksheets("DDérivée seconde")
    ws1.Range("A:IV").ClearContents 'suppression des données contenues dans les feuilles
    ws2.Range("A:IV").ClearContents
    ws3.Range("A:IV").ClearContents
    ws4.Range("A:IV").ClearContents
    ws5.Range("A:IV").ClearContents
    ws6.Range("A:IV").ClearContents
End Sub
Sub supdoss() 'suppression du dossier
 
    Dim fso As New FileSystemObject
    Dim doss As Folder
    Dim ws0 As Worksheet
    Set ws0 = Worksheets("Macro")
    If fso.FolderExists(ws0.[E24]) Then 'Vérifie si le répertoire existe.
        Set doss = fso.GetFolder(ws0.[E24]) 'Accède au dossier
        doss.Delete
    End If
End Sub
Sub Import()
 Call supdoss
 Call sup
    Sheets("Macro").Range("E9").Value = ThisWorkbook.Path
    Dim fso As Object 'Déclarations des variables
    Dim FsoRepertoire As Object
    Dim FsoFichier As Object
    Dim i As Long
    Dim c As Integer
    Dim strLigne As String
    Dim str() As String
    Set fso = CreateObject("Scripting.FileSystemObject") 'Attribution de valeurs
    Set FsoRepertoire = fso.GetFolder(Sheets("Macro").Range("E11").Value) 'nom du répertoire
    c = 2 'Boucle sur fichiers du repertoire
        For Each FsoFichier In FsoRepertoire.Files
            i = 2
            str = Split(FsoFichier.Name, ".") 'Vérifie si le fichier a l'extension souhaité
                If str(UBound(str)) = "dpt" Then
                    Sheets("DDonnées brutes").Cells(1, c).Value = NomFichierSansExtension(FsoFichier.Name)
                    Open FsoFichier.Path For Input As #1 'ouvre le fichier
                        Do While Not EOF(1) 'Boucle sur chaque ligne du fichier
                            Line Input #1, strLigne
                            str = Split(strLigne, Chr(9))
                            Sheets("DDonnées brutes").Cells(i, c).Value = str(1) 'insere la ligne dans la cellule
                            If c = 2 Then
                                Sheets("DDonnées brutes").Cells(i, 1).Value = str(0)
                            End If
                            i = i + 1
                        Loop
                    Close #1
                    c = c + 1
                End If
        Next
    Call test 'Démarrage de la seconde macro
    Call Copie
End Sub
Sub Copie()
    Dim ws0 As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet, ws6 As Worksheet 'Déclaration des variables
    Const PremL1 = 2 'Première ligne de données dans la feuille 1
    Const PremC1 = 1 'Première colonne de données dans la feuille 1
    Dim DerL1 As Long 'Dernière ligne 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
    Dim Lig As Long
    Dim Lign As Long
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Attribution de valeurs
    Set ws0 = Worksheets("Macro")
    Set ws1 = Worksheets("DDonnées brutes") 'L'objet Feuille 1 est attribué à la variable ws1
    Set ws2 = Worksheets("DSoustraction") 'L'objet Feuille 2 est attribué à la variable ws2
    Set ws3 = Worksheets("DCorrection ligne de base") 'L'objet Feuille 3 est attribué à la variable ws3
    Set ws4 = Worksheets("DN-(N-1)")
    Set ws5 = Worksheets("DDérivée première")
    Set ws6 = Worksheets("DDérivée seconde")
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    DerL1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche de la dernière ligne renseignée dans la colonne A de la feuille 1
    DerC1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column 'Recherche de la dernière colonne renseignée dans la ligne 1 de la feuille 1
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Enregistrement données brutes
    Application.ScreenUpdating = False
    For Col = PremC1 To DerC1 - 1 'boucle sur colonne
        Workbooks.Add 1 'ajout d'un classeur avec 1 feuille
        ws1.Range(ws1.Cells(2, 1), ws1.Cells(DerL1, 1)).Copy [A1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ws1.Range(ws1.Cells(2, Col + 1), ws1.Cells(DerL1, Col + 1)).Copy [B1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ActiveWorkbook.SaveAs ws0.[E12] & ws1.Cells(1, Col + 1) & ".txt", xlTextWindows 'enregistrement au format txt
        'ActiveWorkbook.SaveAs ws0.[E13] & ws1.Cells(1, Col + 1) & ".csv", xlCSV, Local:=True'enregistrement au format csv
        ActiveWorkbook.Close False 'fermeture du classeur texte
    Next Col
    Application.ScreenUpdating = True
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'soustraire la colonne B de la feuille 1 à toutes les autres colonnes pour renseigner la feuille 2
    Application.ScreenUpdating = False
    ws1.Range("A:A").Copy ws2.Range("A:A") 'Recopie de la colonne A de la feuille ws1 dans la feuille ws2
    For Col = PremC1 To DerC1 - 1 'boucle sur colonne
        ws1.Cells(1, 1).Copy ws2.Cells(1, 1) 'recopie les entêtes de colonnes
        If Col > 1 Then 'si colonne supérieure à A alors recopie en tête de colonne
            ws1.Cells(1, Col + 1).Copy ws2.Cells(1, Col)
        End If
    Next Col
    For Col = PremC1 To DerC1 - 2 'boucle sur les colonnes
        For Lig = PremL1 To DerL1 'boucle sur ligne
            ws2.Cells(Lig, Col + 1) = ws1.Cells(Lig, Col + 2) - ws1.Cells(Lig, PremC1 + 1) 'formule soustraction colonne B à toutes les autres
        Next Lig
        'Enregistrement soustraction
        Workbooks.Add 1 'ajout d'un classeur avec 1 feuille
        ws2.Range(ws2.Cells(2, 1), ws2.Cells(DerL1, 1)).Copy [A1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ws2.Range(ws2.Cells(2, Col + 1), ws2.Cells(DerL1, Col + 1)).Copy [B1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ActiveWorkbook.SaveAs ws0.[E14] & ws1.Cells(1, Col + 2) & ".txt", xlTextWindows 'enregistrement au format txt
        'ActiveWorkbook.SaveAs ws0.[E15] & ws1.Cells(1, Col + 1) & ".csv", xlCSV, Local:=True'enregistrement au format csv
        ActiveWorkbook.Close False 'fermeture du classeur texte
    Next Col
    Application.ScreenUpdating = True
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'soustraire la ligne 1090 de la feuille 2 à toutes les autres lignes pour renseigner la feuille 3
    Application.ScreenUpdating = False
    ws1.Range("A:A").Copy ws3.Range("A:A") 'Recopie de la colonne A de la feuille ws1 dans la feuille ws3
    For Col = PremC1 To DerC1 - 1 'boucle sur colonne
        ws1.Cells(1, 1).Copy ws3.Cells(1, 1) 'recopie les entêtes de colonnes
        If Col > 1 Then 'si colonne supérieure à A alors recopie en tête de colonne
            ws1.Cells(1, Col + 1).Copy ws3.Cells(1, Col)
        End If
    Next Col
    For Col = PremC1 To DerC1 - 2 'boucle sur les colonnes
        For Lig = PremL1 To DerL1 'boucle sur les lignes
            ws3.Cells(Lig, Col + 1) = ws2.Cells(Lig, Col + 1) - ws2.Cells(1090, Col + 1) 'formule soustraction ligne 109 à toutes les autres
        Next Lig
        'Enregistrement correction ligne de base
        Workbooks.Add 1 'ajout d'un classeur avec 1 feuille
        ws3.Range(ws3.Cells(2, 1), ws3.Cells(DerL1, 1)).Copy [A1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ws3.Range(ws3.Cells(2, Col + 1), ws3.Cells(DerL1, Col + 1)).Copy [B1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ActiveWorkbook.SaveAs ws0.[E16] & ws1.Cells(1, Col + 1) & ".txt", xlTextWindows 'enregistrement au format txt
        'ActiveWorkbook.SaveAs ws0.[E17] & ws1.Cells(1, Col + 1) & ".csv", xlCSV, Local:=True'enregistrement au format csv
        ActiveWorkbook.Close False 'fermeture du classeur texte
    Next Col
    Application.ScreenUpdating = True
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'N-(N-1)
    Application.ScreenUpdating = False
    ws1.Range("A:A").Copy ws4.Range("A:A") 'Recopie de la colonne A de la feuille ws1 dans la feuille ws4
    For Col = PremC1 To DerC1 - 1 'boucle sur colonne
        ws1.Cells(1, 1).Copy ws4.Cells(1, 1) 'recopie les entêtes de colonnes
        If Col > 1 Then 'si colonne supérieure à A alors recopie en tête de colonne
            ws1.Cells(1, Col + 1).Copy ws4.Cells(1, Col)
        End If
    Next Col
    For Col = PremC1 To DerC1 - 2 'boucle sur les colonnes
        For Lig = PremL1 To DerL1 'boucle sur les lignes
            ws4.Cells(Lig, Col + 1) = ws3.Cells(Lig, Col + 2) - ws3.Cells(Lig, Col + 1) 'formule N-(N-1)
        Next Lig
        'Enregistrement N-(N-1)
        Workbooks.Add 1 'ajout d'un classeur avec 1 feuille
        ws4.Range(ws4.Cells(2, 1), ws4.Cells(DerL1, 1)).Copy [A1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ws4.Range(ws4.Cells(2, Col + 1), ws4.Cells(DerL1, Col + 1)).Copy [B1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ActiveWorkbook.SaveAs ws0.[E18] & ws1.Cells(1, Col + 1) & ".txt", xlTextWindows 'enregistrement au format txt
        'ActiveWorkbook.SaveAs ws0.[E19] & ws1.Cells(1, Col + 1) & ".csv", xlCSV, Local:=True'enregistrement au format csv
        ActiveWorkbook.Close False 'fermeture du classeur texte
    Next Col
    Application.ScreenUpdating = True
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'dérivée première de la feuille 3 pour renseigner la feuille 5
    Application.ScreenUpdating = False
    ws1.Range(ws1.Cells(3, 1), ws1.Cells(DerL1 - 1, 1)).Copy ws5.Range("A2") 'Recopie de la colonne A3 à ADerL1-1 de la feuille ws1 dans la feuille ws5
    For Col = PremC1 To DerC1 - 1 'boucle sur colonne
        ws1.Cells(1, 1).Copy ws5.Cells(1, 1) 'recopie les entêtes de colonnes
        If Col > 1 Then 'si colonne supérieure à A alors recopie en tête de colonne
            ws1.Cells(1, Col + 1).Copy ws5.Cells(1, Col)
        End If
    Next Col
    For Col = PremC1 To DerC1 - 2 'boucle sur les colonnes
        For Lig = PremL1 + 1 To DerL1 - 1 'boucle sur les lignes
            ws5.Cells(Lig - 1, Col + 1) = (ws3.Cells(Lig + 1, Col + 1) - ws3.Cells(Lig - 1, Col + 1)) / (ws3.Cells(Lig + 1, 1) - ws3.Cells(Lig - 1, 1)) 'formule dérivée première
        Next Lig
        'Enregistrement dérivée première
        Workbooks.Add 1 'ajout d'un classeur avec 1 feuille
        ws5.Range(ws5.Cells(2, 1), ws5.Cells(DerL1, 1)).Copy [A1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ws5.Range(ws5.Cells(2, Col + 1), ws5.Cells(DerL1, Col + 1)).Copy [B1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ActiveWorkbook.SaveAs ws0.[E20] & ws1.Cells(1, Col + 1) & ".txt", xlTextWindows 'enregistrement au format txt
        'ActiveWorkbook.SaveAs ws0.[E21] & ws1.Cells(1, Col + 1) & ".csv", xlCSV, Local:=True'enregistrement au format csv
        ActiveWorkbook.Close False 'fermeture du classeur texte
    Next Col
    Application.ScreenUpdating = True
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'dérivée seconde de la feuille 3 pour renseigner la feuille 6
    Application.ScreenUpdating = False
    ws5.Range(ws5.Cells(3, 1), ws5.Cells(DerL1 - 1, 1)).Copy ws6.Range("A2") 'Recopie de la colonne A3 à ADerL1-1 de la feuille ws5 dans la feuille ws6
    For Col = PremC1 To DerC1 - 1 'boucle sur colonne
        ws1.Cells(1, 1).Copy ws6.Cells(1, 1) 'recopie les entêtes de colonnes
        If Col > 1 Then 'si colonne supérieure à A alors recopie en tête de colonne
            ws1.Cells(1, Col + 1).Copy ws6.Cells(1, Col)
        End If
    Next Col
    For Col = PremC1 To DerC1 - 2 'boucle sur les colonnes
        For Lig = PremL1 + 1 To DerL1 - 1 'boucle sur les lignes
            ws6.Cells(Lig - 1, Col + 1) = (ws5.Cells(Lig + 1, Col + 1) - ws5.Cells(Lig - 1, Col + 1)) / (ws5.Cells(Lig + 1, 1) - ws5.Cells(Lig - 1, 1)) 'formule dérivée seconde
        Next Lig
        'Enregistrement soustraction
        Workbooks.Add 1 'ajout d'un classeur avec 1 feuille
        ws6.Range(ws6.Cells(2, 1), ws6.Cells(DerL1, 1)).Copy [A1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ws6.Range(ws6.Cells(2, Col + 1), ws6.Cells(DerL1, Col + 1)).Copy [B1] 'copie des colonnes qui vont bien dans le nouveau classeur
        ActiveWorkbook.SaveAs ws0.[E22] & ws1.Cells(1, Col + 1) & ".txt", xlTextWindows 'enregistrement au format txt
        'ActiveWorkbook.SaveAs ws0.[E23] & ws1.Cells(1, Col + 1) & ".csv", xlCSV, Local:=True'enregistrement au format csv
        ActiveWorkbook.Close False 'fermeture du classeur texte
    Next Col
    Application.ScreenUpdating = True
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'En tête des feuilles
    Dim x As Byte
    For x = 1 To Sheets.Count
        With Sheets(x).PageSetup
            .CenterHeader = "&B&12&""Arial""" & ws0.Range("E35") & Chr(10) & "&A" 'nom échantillon, nom de la feuille en arial gras 12
        End With
    Next x
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Libère les ressources
    Set ws1 = Nothing
    Set ws2 = Nothing
    Set ws3 = Nothing
    Set ws4 = Nothing
    Set ws5 = Nothing
    Set ws6 = Nothing
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    MsgBox "L'import, le traitement et la sauvegarde des données sont terminés et se sont déroulés correctement" 'Message box pour indiquer la fin de la macro
End Sub

Merci du temps que tu veux bien me consacrer, j'apprécie énormément

**MarcelG** · 16/01/2012, 11h09

Salut Vincent,

Comme indiqué dans l'aide en ligne, à l'argument

Code :

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

Fileneme

de la méthode

Code :

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

SaveAs

peut être affecté le chemin complet du classeur.

Tu peux donc utiliser une concaténation du type

Code :

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

1
2
3
With Sheets("Macro")
        ThisWorkbook.SaveAs Filename:=.[E9] & "/" & .[E35] & ".xls"
End With

Remarques :
- le processus serait le même pour la méthode SaveCopyAs
- adapte ce code en fonction du contenu des cellules E9 et E35 de la feuille Macro, notamment en ce qui concerne le caractère "/" (Application.PathSeparator) et l'extension ".xls".

**Vincent32** · 16/01/2012, 11h25

Merci beaucoup Marcel,

J'ai enfin compris comment ça fonctionnait (je comprends vite mais il faut m'expliquer longtemps

). Le code fonctionne parfaitement.

Encore merci

Sauvegarde classeur excel selon nom de cellule à la fin de la macro

Macros et VBA Excel

Discussions similaires

Partager

Partager