Discussion :

[Dereck07]

Bonjour,

Je desire créer une macro qui copie le classeur courant et qui enregistre la copie sous un nom different en y apportant quelques modifications.

Voila ce que j'ai commencé à faire:

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
 
Private Sub CommandButton1_Click() 'Extract
'Déclaration Data
Dim fileSaveName, InitialFileName, NoSemaine
Dim NewClasseur As Workbook
Dim MaFeuille As Worksheet
 
'sauvegarde des Mise a jour avant copie
ActiveWorkbook.Save
 
'Creation d'une copie
Set NewClasseur = ActiveWorkbook
Set MaFeuille = NewClasseur.Worksheets(1)
 
'Suppression des info perso
MaFeuille.Columns("T:BY").Select
Selection.Delete Shift:=xlToLeft
 
'Enregistrement du nouveau classeur
NoSemaine = Format(Date, "ww", , vbFirstFourDays)
InitialFileName = "Commun - S" & NoSemaine & ".xls"
fileSaveName = Application.GetSaveAsFilename(InitialFileName, fileFilter:="Excel Files (*.xls), *.xls")
NewClasseur.SaveAs (fileSaveName)
NewClasseur.Close
 
End Sub

Bien que ce code fonctionne il ne fait pas exactement ce que j'aimerai faire.
Enfaite il modifie le classeur en cours et l'enregistre sous un autre nom.
1) Ce que j'aimerai faire c'est copier le classeur en cours dans NewClasseur. Ne pas pas l'afficher et effectuer les modif et l'enregister. Comme cela le fichier modifier est créer mais le fichier principal d'ou la macros a été lancé reste inchangé et affiché tel qu'il était losque la macro a été lancé.
2) De plus pour lancer la macro j'ai un bouton CommandButton1 et la fonction associé CommandButton1_Click. J'aimerai suprimer cette objet et cette macro de la copie faite dans NewClasseur. Quelqu'un a t il une idée de comment cela peut ce faire?

[Singular]

Crées un nouveau classeur et copies-y les feuilles de ton classeur original. Après avoir copié les feuilles, supprimes le bouton de commande par la commande :

Code :

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

Worksheets(nomDeTaFeuille).Buttons(nomDuBouton).Delete

si le bouton provient de la barre de commande "Formulaire". La variable 'nomDuBouton' est le nom qui s'affiche dans la zone nom à gauche de la barre de formule quand tu sélectionne le bouton.

Ou bien, si le bouton provient de la barre "Boîte à outils Contrôles", écris:

Code :

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

Worksheets(nomDeTaFeuille).OLEObjects(nomDuBouton).Delete

Pour sélectionner le bouton sans l'activer pour voir son nom, tu dois cliquer sur le bouton qui ressemble à la flèche de la souris, sur la barre de commande "Dessin"

Renommes ensuite le nouveau classeur en le sauvegardant et fermes-le.

Cette façon de procéder ne copie pas les module généraux du classeur et celui appelé ThisWorkbook mais copie toutes les procédures contenues dans les modules des feuilles copiées...

[Dereck07]

Merci Singular,

J'ai utilisé la commande que tu m'as donné:

Code :

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

1
2
 
Worksheets(1).OLEObjects(1).Delete

Ca suprime bien le bouton

Parcontre je n'arrive pas ajouter une copie de la premiere feuille du classeur courant dans New classeur.
J'ai essayé ca mais je me fais jeter avec un message d'erreur:

Code :

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

1
2
 
NewClasseur.Sheets.Add = ActiveWorkbook.Worksheets(1)

[Singular]

Voici un exemple de ce que tu peux faire:

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
Sub CopierClasseurNouveau()
    Dim wks As Worksheet
    Dim wkb As Workbook
    Dim lNombreFeuillesDepart As Long
    Dim i As Long
 
    Application.ScreenUpdating = False
    Set wks = ThisWorkbook.Sheets("ACopier")
 
    ' Creer le nouveau classeur
    Set wkb = Workbooks.Add
    ' Prendre en note  le nombre de feuilles par défaut dans le
    '       nouveau classeur pour suppression ultérieure.
    lNombreFeuillesDepart = wkb.Sheets.Count
 
    ' Copier la feuille
    wks.Copy Before:=wkb.Sheets(1)
    ' Affecter le même nom à la nouvelle feuille
    wkb.Sheets(1).Name = wks.Name
 
    ' Supprimer les feuilles présentes par défaut dans le
    '       nouveau classeur
    Application.DisplayAlerts = False
    For i = 1 To lNombreFeuillesDepart
        wkb.Sheets(wkb.Sheets.Count).Delete
    Next i
    wkb.SaveAs "Nouveau.xls"
    wkb.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

[fring]

Merci Singular,

Parcontre je n'arrive pas ajouter une copie de la premiere feuille du classeur courant dans New classeur.
J'ai essayé ca mais je me fais jeter avec un message d'erreur:

Code :

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

1
2
 
NewClasseur.Sheets.Add = ActiveWorkbook.Worksheets(1)

Bonjour, si c'est pour simplement faire une copie de la feuille active dans un nouveau classeur il suffit d'écrire ActiveSheet.Copy et un nouveau classeur sera automatiquement créé avec cette feuille

[Dereck07]

Singular, fring encor merci de votre aide.
Je continue à galèrer j'ai testé ce code qui ne marche pas:

Code :

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

1
2
3
4
5
6
7
8
9
'Déclaration Data
Dim CurrentClasseur, NewClasseur As Workbook
Dim MaFeuille As Worksheet
 
'Creation d'une copie 
Set CurrentClasseur = ActiveWorkbook
Set NewClasseur = Workbooks.Add(1)
Set MaFeuille = CurrentClasseur.Worksheets(1) 'feuille à copier
NewClasseur.Worksheets(1) = MaFeuille.Copy 'réalisation de la copie

j'ai une erreur sur la ligne Set MaFeuille = CurrentClasseur.Worksheets(1).
Alors qu'avant ca marchait trés bien. Le fait d'ajouter Set NewClasseur = Workbooks.Add(1) juste devant a amméné l'erreur. Je ne comprends pas... Si quelqu'un voit ce qui bloque?

Singular, j'ai noté ton idée d'utiliser Application.ScreenUpdating = False pour que la copie soit invisible. je l'implémenterai apres.
Parcontre dans ton code il y a des lignes que je ne comprends pas:

Code :

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

1
2
' Copier la feuille
    wks.Copy Before:=wkb.Sheets(1)

La manière dont j'utilise le .copy revient elle au même?
Comment marche l'instruction Before? (je suis pas habitué a cette syntaxe)

[fring]

Bonjour,

Bon...si ActiveSheet.Copy ne te convient pas essaye ceci

Code :

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

1
2
3
4
5
6
7
8
9
10
 
Sub test()
Dim wkb As String
Dim wkbn As String
wkb = ActiveWorkbook.Name
Workbooks.Add
wkbn = ActiveWorkbook.Name
Windows(wkb).Activate
Sheets(1).Copy Before:=Workbooks(wkbn).Sheets(1)
End Sub

[Dereck07]

Ha lala... Ca y est presque...
Voila le code que j'ai mis:

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
 
Private Sub CommandButton1_Click() 
'Déclaration Data
Dim fileSaveName, InitialFileName
Dim VbComp As Object
Dim WkbCurrent As String
Dim WkbNew As String
 
 
'sauvegarde des Mise a jour avant copie
ActiveWorkbook.Save
 
'Creation d'une copie 
WkbCurrent = ActiveWorkbook.Name
Workbooks.Add
'ActiveWorkbook.Name = "Copie"
WkbNew = ActiveWorkbook.Name
Windows(WkbCurrent).Activate
Sheets(1).Copy Before:=Workbooks(WkbNew).Sheets(1)
Windows(WkbNew).Activate
 
'Suppression des données perso
ActiveWorkbook.Sheets(1).Columns("T:BY").Select
Selection.Delete Shift:=xlToLeft
 
'Supression des 3 boutons de la feuille principale de la copie
ActiveWorkbook.Sheets(1).OLEObjects(1).Delete
ActiveWorkbook.Sheets(1).OLEObjects(1).Delete
ActiveWorkbook.Sheets(1).OLEObjects(1).Delete
 
'Supression des macros vba de la copie
For Each VbComp In ActiveWorkbook.VBProject.VBComponents
Select Case VbComp.Type
Case 1 To 3
ActiveWorkbook.VBProject.VBComponents.Remove VbComp
Case Else
With VbComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VbComp
 
 
'Enregistrement du nouveau classeur
InitialFileName = "new.xls"
 
fileSaveName = Application.GetSaveAsFilename(InitialFileName, fileFilter:="Excel Files (*.xls), *.xls")
ActiveWorkbook.SaveAs (fileSaveName)
ActiveWorkbook.Close 'fermeture de la copie
 
End Sub

Tout passe maginfiquement bien.
Ensuite je ferme excel et ouvre la copie.
la copie s'ouvre et j'ai une fenêtre qui souvre avec marqué dessu:

Le classeur que vous avez ouvert comporte des liaison avec un autre classeur.
*Si vous mettez les liaisons à jour, Excel tente de recupérer les dernieres données.
*Si vous ne les mettez pas à jour, Excel utilise les informations précédentes

Apres j'ai le choix entre 2 boutons:
-Mettre à jour
-Ne pas mettre à jour

Je clique sur "Ne pas mettre à jour"
Le fichier s'ouvre il est exactement comme je le souhaite avec plus aucun bouton, plus aucune macro, et les donnée person son bien enlevé.
Je comprend pas d'où sorte cette liaison avec le fichier précedent?
quelqu'un sais t il de quoi il s'agit et comment suprimer cette liaision?

[Dereck07]

Probleme résolu!

Je vous explique. Enfaite, je copier une page qui avait un lien sur la feuille suivante:

='Feuille2'!F8

Lors de la copie excel transforme la formule precedente en:

='C:\Documents and Settings\tom\Bureau\[FileSource.xls]Feuille2'!F8

Ce qui est logique puisque le feuille2 n'existe pas dans le nouveau classeur.

J'ai donc ajouté le code suivant pour remplacer le formule ='C:\Documents and Settings\tom\Bureau\[FileSource.xls]Feuille2'!F8 par sa valeur de la feuille2 du classeur source:

'Creation d'une copie
WkbCurrent = ActiveWorkbook.Name
Workbooks.Add
WkbNew = ActiveWorkbook.Name
Windows(WkbCurrent).Activate
valeur = ActiveWorkbook.Sheets(2).Cells(8, 6).Value
Sheets(1).Copy Before:=Workbooks(WkbNew).Sheets(1)
Windows(WkbNew).Activate
ActiveWorkbook.Sheets(1).Cells(1, 3).Value = valeur

Encor merci à tout ceux qui m'ont aidés

[Singular]

Désolé Dereck0, mais les messages de cette discussion se gâtent à partir du message numéro 6.

En fait, le code que je t'ai donné en #4 fonctionne parfaitement pour faire une copie des feuilles d'un classeur vers un autre. Aucun des modules de code n'est copié, donc pas besoin de passer par VBComponents pour supprimer ces modules.

Ton erreur provient de la ligne

Code :

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

Set NewClasseur = Workbooks.Add(1)

La méthode Workbooks.Add ne s'utilise pas comme ça. Si tu regardes l'aide sur cette méthode, tu verras que 1 n'est pas une valeur acceptée, sauf si tu veux créer le classeur selon un Template nommé "1.xls".

Pour ce qui est d'utiliser Windows(WkbCurrent) ou Windows(WkbNew), ce n'est pas tres bon!

Tu connais d'avance le nom des feuilles que tu veux copier et tu peux toujours y accéder par Sheets(NomDeTaFeuille).

[Dereck07]

Oui c'est vrai dans ton exemple il n'y a pas de 1.

Merci Singular

[Singular]

Donnes-moi des nouvelles sur ton implémentation du code.

Et quand ton problème sera résolu, n'oublies pas de cliquer sur le bouton "Résolu"...

[Dereck07]

Re bonjour,

J'ai ajouté cette question a la suite de ce post car c'est une question qui tourne autour du même sujet. J'ai fait un code qui permet d'ouvrir un autre classeur et qui copie toute les cellules de la premier page du classeur ouvert pour les copier dans la premiere page du classeur ou a été lancé la macros.
Ce code ne fonctionne pas et je vois pas pk...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub CommandButton1_Click()
Dim WkbVierge, WkbOld As Workbook
Set WkbVierge = ActiveWorkbook
'Ouverture de l'ancien fichier
FileOpenName = Application.GetOpenFilename(fileFilter:="Excel Files (*.xls), *.xls")
Workbooks.Open (FileOpenName)
Set WkbOld = ActiveWorkbook
'Copie des anciennes donné dans le nouveau classeur
WkbOld.Sheets(1).Cells.Copy             'Copie Feuille 1
WkbVierge.Sheets(1).Cells.Paste
End sub

La copie semble fonctionner mais pas le coller.
Si quelqu'un a des suggestions?

[Qwazerty]

SAlut
Essais voir comme ca

Code :

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

WkbOld.Sheets(1).Cells.Copy  WkbVierge.Sheets(1).range("A1")

A++
Qwaz

[Dereck07]

Merci Qwazerty,

Ca marche nikel!

[Singular]

Code :

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

WkbVierge.Sheets(1).Cells.Paste

Cells est un objet Range et l'objet Range n'a pas de méthode appelée Paste. Avec Range, la méthode s'appelle PasteSpecial.

[Dereck07]

D'accord, merci