Discussion :

[Enthau]

Bonjour,

j'ai un fichier Excel, et lorsque je le sauvegarde, je souhaite sauvegarder en même temps une copie à un autre emplacement.
Pour cela, j'ai ce code :

Code :

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

1
2
3
4
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Chemin = "\\serveur\partage\"
    ThisWorkbook.SaveAs Chemin & "MaCopie.xls"
End Sub

Le problème, c'est que ça me garde la macro.
Comment faire pour que la copie soit sans code VBA ?

Merci

[Krovax]

Je pense que tu pourrais essayer de supprimer le code par la suite. Quelques idées :
Une contribution de ouskel'n'or pour supprimer les module
http://www.developpez.net/forums/d33...fichier-donne/
Le tuto pour piloter l'éditeur de macro
http://silkyroad.developpez.com/VBA/VisualBasicEditor/

Après ne te lance pas tout de suite il est probable que quelqu'un ai une méthode directe bien plus simple

[aalex_38]

Bonjour,

A mon avis tout dépend si tu as du code dans les feuilles ou pas.

Si tu n'as pas de code, il te suffit de copier les feuilles dans un nouveau classeur.

Sinon je ne vois pas de solution de contournement à part la suppression du code.

Edit : Une autre solution possible serait de recopier toutes les données d'un classeur a l'autre, mais dans ce cas je prfère la suppression de macro.

Edit2 : Même dans ma version 2003, je viens de me rendre compte que je peux convertir au format 2007 et avec l'extension xlsx plus de macro, je n'ai pas essayé si c'est possible par code, a voir.

[Krovax]

Edit2 : Même dans ma version 2003, je viens de me rendre compte que je peux convertir au format 2007 et avec l'extension xlsx plus de macro, je n'ai pas essayé si c'est possible par code, a voir.

A condition d'avoir installer la mise a jour pour être compatible avec 2007. Ce qui n'est pas le cas partout (en tout cas c'est pas fait la ou je suis )
Mais si cela est possible c'est la solution la plus simple

[Enthau]

Je n'ai pas de code dans les feuilles.
Comment faire pour copier les feuilles dans un nouveau classeur ? En plus, j'ai une dizaine de feuilles...
Merci

[Krovax]

Pour copier les feuilles

Code :

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

1
2
3
4
5
6
7
8
9
 
dim ws as worksheet 'déclaration de la variable ws est du type onglet
Application.ScreenUpdating = False 'pas de mise a jour de l'écran
For each ws in thisworkbook.worksheets
'pour chaque onglet parmis les onglets de ce classeur
ws.Copy After:=Workbooks("CopisansMacro.xls").Sheets(Workbooks("CopisansMacro.xls").sheets.count)
'on copy le 'onglet après le dernier du classeur CopisansMacro.xls
next ws
Application.ScreenUpdating = True 'mise a jour de l'écran

Ps : Cela ne fonctionnera pas avec les onglet Graphique

Edit : j'ai ajouté les Application.ScreenUpdating

[Enthau]

Merci pour ta réponse, Krovax, mais ça marche pas.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Chemin = "\\serveur\partage\"
dim ws as worksheet 'déclaration de la variable ws est du type onglet
Application.ScreenUpdating = False 'pas de mise a jour de l'écran
For each ws in thisworkbook.worksheets
'pour chaque onglet parmis les onglets de ce classeur
ws.Copy After:=Workbooks(Chemin & "MaCopie.xls").Sheets(Workbooks(Chemin & "MaCopie.xls").sheets.count)
'on copy le 'onglet après le dernier du classeur CopisansMacro.xls
next ws
Application.ScreenUpdating = True 'mise a jour de l'écran
 
End Sub

[Krovax]

Ca ne marche pas? C'est normale!
Ca n'a pas de pattes (j'adore cette phrase)

Il faudrait peut être ouvrir le classeur avant de faire la copie, (et le fermer en enregistrant sans doute)
Je te laisse lire l'aide sur
open
et close
bon allez sans tester

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
dim ws as worksheet
dim chemin as string 'on déclare les variables et on le défini après les déclaration sinon.... c'est le drame
    Chemin = "\\serveur\partage\"
Workbooks.Open Filename:=Chemin & "MaCopie.xls"
For each ws in thisworkbook.worksheets
'pour chaque onglet parmis les onglets de ce classeur
ws.Copy After:=Workbooks("MaCopie.xls").Sheets(Workbooks( "MaCopie.xls").sheets.count)
'on copy le 'onglet après le dernier du classeur CopisansMacro.xls
next ws
Workbooks("MaCopie.xls").close True

[Enthau]

Super ça fonctionne, bien que j'ai bcp du mal avec le code...
Par contre (et je vais être encore emm...bétant) comment faire pour que dans ma copie ca me rajoute pas les feuilles après, mais plutot que ca m'ecrase les autres pour les remplacer par ceux créé ?
Merci

[Krovax]

Remplacer ca va être lourd a mettre en place enfin c'est surtout que l'on peux faire tellement plus simple a la fin on vire les première feuille

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
dim ws as worksheet
dom i as integer, n as integer
dim chemin as string 
    Chemin = "\\serveur\partage\"
Workbooks.Open Filename:=Chemin & "MaCopie.xls"
n=Workbooks( "MaCopie.xls").sheets.count 'on stock le nombre de feuille initial
For each ws in thisworkbook.worksheets
'pour chaque onglet parmis les onglets de ce classeur
ws.Copy After:=Workbooks("MaCopie.xls").Sheets(Workbooks( "MaCopie.xls").sheets.count)
'on copy le 'onglet après le dernier du classeur CopisansMacro.xls
next ws
'on supprime les n première feuille
for i = 1 to n
Workbooks("MaCopie.xls").Sheets(i).Delete 
next i
 
Workbooks("MaCopie.xls").close True
 
End Sub

[aalex_38]

aller pour le fun mon code :

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
Sub Essai()
On Error GoTo fin
 
Dim wb As Workbook
Dim num As Integer
Dim sh
Application.DisplayAlerts = False
Application.ScreenUpdating = False
num = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
 
Set wb = Workbooks.Add
 
For Each sh In ThisWorkbook.Sheets
    Debug.Print sh.Name
    On Error Resume Next ''sh.Unprotect Attention les feuilles protegees ne seront pas copiées.
    sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    On Error GoTo 0
Next sh
 
wb.Sheets(1).Delete
 
fin:
 
If Err.Number > 0 Then
    MsgBox "Erreur :" & Err.Number & " Description :' & Err.Description"
End If
 
Application.DisplayAlerts = False
Application.SheetsInNewWorkbook = num
Application.ScreenUpdating = True
 
End Sub

Edit : Avec ce code les graphiques sont copiés;
Les feuilles protégées ne le sont pas.
Le nom de la première feuille Feuil1 peut devenir Feuil1(2).

[aalex_38]

J'ai revu mon code, avec en plus la sauvegarde du fichier et la possibilté de copier les feuilles protégées.

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
Sub Essai()
On Error GoTo fin
'----------------------------------'
' Definition des variables
'----------------------------------'
Dim wb As Workbook
Dim num As Integer
Dim sh
Dim MonFilename As String
 
MonFilename = ThisWorkbook.Path & "\" & "LenomdeMonNouveauClasseur.xls"
'-----------------------------------------------------'
' Creation du nouveau classeur avec une seule feuille
'-----------------------------------------------------'
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    num = .SheetsInNewWorkbook
    .SheetsInNewWorkbook = 1
End With
 
Set wb = Workbooks.Add
 
'-----------------------------------------------------'
' copie des feuilles dans le nouveau classeur         '
'-----------------------------------------------------'
For Each sh In ThisWorkbook.Sheets
    On Error Resume Next
    sh.Unprotect
    On Error Resume Next
    sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    On Error GoTo 0
Next sh
 
wb.Sheets(1).Delete
 
On Error Resume Next
wb.SaveAs Filename:=MonFilename
On Error GoTo 0
'-----------------------------------------------------'
fin:
'-----------------------------------------------------'
If Err.Number > 0 Then
    MsgBox "Erreur :" & Err.Number & " Description :' & Err.Description"
End If
 
With Application
    .DisplayAlerts = False
    .SheetsInNewWorkbook = num
    .ScreenUpdating = True
End With
 
End Sub