Bonjour à tous,

j'ai cherché un peu sur ce forum et je n'arrive pas à adapter comme je le voudrais le code que j'ai trouvé.

Actuellement j'ai un gros fichier excel avec beaucoup de feuilles dont une qui sert de base de donnée et une autre qui va générer une fiche de transport.
Je souhaiterai enregistrer cette fiche de transport dans un nouveau classeur qui ne soit plus lié au classeur initial.
Pour cela je copie la feuille dans un nouveau classeur sélectionne la zone et colle les valeur uniquement sur la même zone. Enfin je supprime le bouton qui me sert à enregistrer la feuille dans le nouveau classeur.

Ensuite c'est là que ça se corse : je veut sauvegarder le nouveau classeur.
J'ai créé un code qui fonctionne sous excel 2003 mais pas sous 2010 car même si la fenètre de dialogue s'ouvre le nom par défaut déjà incrémenté n'apparait pas dans la case et je n'ai aucun type de fichier associé.

Voici le 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
 
Sub EnregFicheTrans()
 
    Sheets("Fiche transport").Select 'sélectionne la feuille fiche de transport
    Sheets("Fiche transport").Copy 'copie la feuille dans un nouveau classeur
    Range("A1:H47").Select 'sélectionne la zone de la fiche dans le nouveau classeur
    Selection.Copy 'copie la zone du nouveau classeur dans le presse-papier
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'colle les valeurs uniquement dans le nouveau classeur
 
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.Delete
 
Dim addrfeuisauv As String
 
addrfeuisauv = "C:\" 'Chemin sauvegarde
 
Do
chaine$ = "Camion N°" & Index + 1 & ".xls"
myfile = Dir(addrfeuisauv & chaine$) 'existe t il déja?
    If myfile <> "" Then Index = Index + 1 'si oui, incrémenter index
        If myfile = "" Then Exit Do   'si le fichier n'existe pas, sortir de la boucle d'incrémentation
Loop
 
Do
ChDir addrfeuisauv
fName = Application.GetSaveAsFilename(addrfeuisauv & chaine$) 'ouvre boite de dialogue enregistrement
Loop Until fName <> False
 
ActiveWorkbook.SaveCopyAs Filename:=fName ' enregistre nouveau fichier
 
End Sub