[VBA-E]Définir un nom au classeur créé

Version imprimable

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:

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

30/04/2006, 12h10
SfJ5Rpw8
au moment de l'ajout tu peu affecter à une variable workbook ton classeur
Code:

1 2 3 4 Dim wk As Workbook Set wk = Workbooks.Add
tu utilise ensuite cette variable.. par exemple :
Code:

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:

1 2 wk.SaveAs "c:\tmp\MonNouveauClasseurs"
30/04/2006, 13h20
LeSqual

je n'y arrive pas...je bloque sur ton code
30/04/2006, 13h35
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:

Set wk = Workbooks.Add

et tu remplace tous les

Code:

Windows("Classeur7" ).Activate

par

Code:

wk.activate

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

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

c'est bon je pense avoir trouvé:

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
 
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 !

Les "Select" ralentissent le code, tu n'es pas obligé de les utiliser.

Code:

1
2
3
4
5
6
7
    Worksheets("Feuil1").Range("A1:J62").Copy
    With Worksheets("Feuil2").Cells(1, 1)
        .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    End With

Plus qu'à adapter

A+

01/05/2006, 09h37
LeSqual

Merci pour votre aide .... le problème est maintenant résolu !