Discussion :

[LeSqual]

Bonjour ,

Présentation du sujet:
Je souhaite faire une macro qui sauvegarde, un copié collé en valeur et en format de deux onglets de mon fichier. Puis qu'elle donne un nom à ce fichier sauvegarder et le ferme.

Mon problème:
Ma macro tourne bien seulement je dois la modifier à chaque fois que je fais un test, en effet le nouveau classeur crée s'appelle "classeur7.xls" puis "classeur8.xls"
comment puis je faire pour remedier à ce eptit problème.

Voici le code que j'utilise:

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
Sub Enregi_V3()  
Dim Nomfichier As String
Dim Emplacement As String 
  
Emplacement = ActiveWorkbook.Sheets(1).Range("C76" )
Nomfichier = ActiveWorkbook.Sheets(1).Range("C77" ) 
  
   Workbooks.Add
    Windows("FichierSource.xls" ).Activate
    Range("A1:J62" ).Select
    Selection.Copy
    Windows("Classeur7" ).Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Windows("FichierSource.xls" ).Activate
    Sheets("ONGLET1" ).Select
    Range("A1:89" ).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Classeur7" ).Activate
    Sheets("ONGLET2" ).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("ONGLET1" ).Select
    Application.CutCopyMode = False
    ChDir _
        Emplacement
    ActiveWorkbook.SaveAs Filename:= _
        Emplacement & "\" & Nomfichier _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Windows("FichierSource.xls" ).Activate
    Sheets("ONGLET1" ).Select
    Range("A2" ).Select
    
Application.Workbooks(Nomfichier & ".xls" ).Save
Application.Workbooks(Nomfichier & ".xls" ).Close
    
End Sub

Je vous remercie de votre et si vous estimez que mon programme peut être améliorer n'hésitez pous vos remarques !!

LeSqual

[SfJ5Rpw8]

au moment de l'ajout tu peu affecter à une variable workbook ton classeur

Code :

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

1
2
3
4
 
Dim wk As Workbook
 
Set wk = Workbooks.Add

tu utilise ensuite cette variable.. par exemple :

Code :

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

1
2
3
4
5
6
 
wk.activate
 
...
wk.sheets("ONGLET1").range("A1:89").copy
...

et pour finir sauver ton classeur avec nouveau nom...

Code :

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

1
2
 
 wk.SaveAs "c:\tmp\MonNouveauClasseurs"

[LeSqual]

je n'y arrive pas...je bloque sur ton code

[SfJ5Rpw8]

et tu bloque ou ...? dans un premier temps tu peu mettre la déclaration de la variable Wk en haut de ton code ... dim wk.... , ensuite tu modifie la ligne
du rajout classeur ...

Code :

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

Set wk = Workbooks.Add

et tu remplace tous les

Code :

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

Windows("Classeur7" ).Activate

par

Code :

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

wk.activate

[LeSqual]

je commence à saisir ...
maintenant mon programme est beaucoup plus court :

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
 
Sub Enregi_V4()
Dim Nomfichier As String
Dim Emplacement As String
Dim W1 As Workbook
Dim W2 As Workbook
 
Emplacement = ActiveWorkbook.Sheets(1).Range("C76")
Nomfichier = ActiveWorkbook.Sheets(1).Range("C77")
 
   Set W1 = ThisWorkbook
'---- Classeur cible à enregistrer ----
Set W2 = Workbooks.Add(xlWBATWorksheet)
 
W1.Sheets(1).Copy after:=W2.Sheets(1)
W1.Sheets(2).Copy after:=W2.Sheets(2)
 
W2.SaveAs Emplacement & "\" & Nomfichier
Application.Workbooks(Nomfichier & ".xls").Close
End Sub

Seulement je souhaite faire une copie des deux feuilles en valeur et format (ie sans les liaisons et macros)
Si tu pouvais m'aider pour cette dernière étape ce serait géniale
Merci d'avance

[LeSqual]

c'est bon je pense avoir trouvé:

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
 
Sub Enregi_V5()
Dim Nomfichier As String
Dim Emplacement As String
Dim W1 As Workbook
Dim W2 As Workbook
Dim sht As Sheets
 
Emplacement = ActiveWorkbook.Sheets(1).Range("C76")
Nomfichier = ActiveWorkbook.Sheets(1).Range("C77")
 
Set W1 = ThisWorkbook
'---- Classeur cible à enregistrer ----
Set W2 = Workbooks.Add(xlWBATWorksheet)
 
'Selection de la zone du premier onglet du fichier source à sauvegarder
    W1.Activate
    Range("A1:J62").Select
    Selection.Copy
 
    ' copie en valeur et en format sur le ficher de sauvegarde des données copiées
    W2.Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
    ' Selection de la zone du deuxieme onglet du fichier source à sauvegarder
    W1.Activate
    Sheets(1).Select
    Range("A1:C89").Select
    Application.CutCopyMode = False
    Selection.Copy
 
    ' copie en valeur et en format sur le ficher de sauvegarde des données copiées
    W2.Activate
    Sheets.Add
    Sheets(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
   ' Windows("fichiersource1.xls").Activate
   ' Sheets(1).Select
   Application.CutCopyMode = False
 
    ' creation et sauvegarde du fichier nouveau fichier obtenu
    ChDir _
        Emplacement
    ActiveWorkbook.SaveAs Filename:= _
        Emplacement & "\" & Nomfichier _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Windows("fichiersource1.xls").Activate
    Sheets(1).Select
    Range("A2").Select
 
Application.Workbooks(Nomfichier & ".xls").Save
Application.Workbooks(Nomfichier & ".xls").Close
End Sub

Merci pour ton aide, si tu vois des amélioratios à y apporter n'hésite pas !!
et encore merci pour ton aide, vraiment très sympa !