un coup de pouce..

[kromitou]

Bonsoir, voilà j'ai récupéré ce p'tit code (merci au créateur...) Il fonctionne trés bien. J'ai rajouté une petite bricole Pour le nom...Bref,mais voilà, y a juste un petit truc....c'est qu'il me ferme le Fichier d'origine or il ne faudrait pas.

en résumé :
Je clic
il sauvergarde renomme le fichier d'origine et le ferme
or il faudrait :
Sauvergarde ; renomme et surtout ne pas fermer l'original.
Voila si quelqu'un peut m'éclairer la dessus... Merci d'avance.

Private Sub CommandButton1_Click()
'Sub sauvegardeIndice()
répertoire = ThisWorkbook.Path
ActiveSheet.Name = "TAB." & Range("A1").Value
NomFichier = Range("A1").Value
nf = Dir(répertoire & "\" & NomFichier & Format(Date, "yyyy_mm_dd_") & "*")
n = 0
Do While nf <> ""
nf = Dir
n = n + 1
Loop
ActiveWorkbook.SaveAs _
Filename:=répertoire & "\" & NomFichier & Format(Date, "yyyy_mm_dd_") & Format(n + 1, "000")
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

 

[emsec72]

Re : un coup de pouce..

slt kromitou je ne sait pas si c 'est cela que tu recherche, mais moi pour enregistrer mes dossiers sous un noms specifique et sans fermer le dossier de base j'utilise ce code,à toi d'y apporter les modif' qui te convienne comme le noms de dossier ainsi que le chemin.

Public Sub enregistrersous()
Dim nom As String
nom = Range("k4") & " " & "le" & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " " & "à" & Hour(Time) & "h" & Minute(Time) & ".xls"
ActiveWorkbook.SaveCopyAs ("f:\permis de feu\historique pdf\janvier 2009" & "\" & nom)
rep = MsgBox("permis de feu enregistré sous :" & nom, vbYes + vbInformation)
End Sub

@+ :emsec72

 

[Staple1600]

Re : un coup de pouce..

Bonsoir


Je verrai ton code plutot de cette façcon

(je te laisse tester)

[FONT=Courier New][COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] CommandButton1_Click()
[COLOR=green]'Sub sauvegardeIndice()[/COLOR]
[COLOR=darkblue]Dim[/COLOR] NomFichier$, nf$, n&, nWkb [COLOR=darkblue]As[/COLOR] Workbook
répertoire = ThisWorkbook.Path
ActiveSheet.Copy
[COLOR=darkblue]Set[/COLOR] nWkb = ActiveWorkbook
NomFichier = Range("A1").Text
nf = Dir(répertoire & "\" & _
NomFichier & _
Format(Date, "yyyy_mm_dd_") & "*.xls")
n = 0
[COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] nf <> ""
nf = Dir
n = n + 1
[COLOR=darkblue]Loop[/COLOR]
    [COLOR=darkblue]With[/COLOR] nWkb
        [COLOR=darkblue]With[/COLOR] .ActiveSheet
        .Name = "TAB." & Range("A1").Value
            [COLOR=darkblue]With[/COLOR] .UsedRange.Cells
                .Value = .Value
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        .SaveAs Filename:=répertoire _
        & "\" & NomFichier & Format(Date, "yyyy_mm_dd_") _
        & Format(n + 1, "000") & ".xls"
        .Close [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]

 

[kromitou]

Re : un coup de pouce..

Merci à Vous 2.........Staple1600 & emsec72.

Je vais tester ça, ce soir....

Mais bon apparement, je devrais me régaler avec ça.

@@+++ et encore merci.