bouton pour enregistrer sur un autre fichier (complexe)

Salut William,
Regarde si cela te convient :

'-------------------------------------------------------
'A mettre dans un module standard du classeur Toto.xls
Sub Enregistrer()
Dim ClasseurDuJour As Workbook
Dim TblFichiers() As String
Dim LeJour As String
Dim I As Integer

Application.ScreenUpdating = False
'construit le nom du classeur
'exemple : mardi-2-juillet-2004.xls
LeJour = WeekdayName(Day(Date)) _
& "-" & Day(Date) _
& "-" & MonthName(Month(Date)) _
& "-" & Year(Date) & ".xls"

'recup des classeurs dans le dossier
'où se trouve le classeur Toto.xls
'(classeur où se trouve cette proc)
TblFichiers = Fichiers(ThisWorkbook.Path)

For I = 1 To UBound(TblFichiers)
If TblFichiers(I) = LeJour Then
'le classeur existe, alors contrôle
'si il est ouvert (si par hazard il
'a été fermé dans la journée)
On Error Resume Next
If IsError(ClasseurDuJour.Name) Then
'si il n'est pas ouvert, l'ouvre
Workbooks.Open TblFichiers(I)
'il est possible de cacher le classeur pour
'éviter l'encombrement
'pour l'afficher : Fenêtre|Afficher...
'***Windows(TblFichiers(I)).Visible = False
Set ClasseurDuJour = Workbooks(TblFichiers(I))
Else
'si il est ouvert
Set ClasseurDuJour = Workbooks(TblFichiers(I))
End If
Exit For
End If
Next I

'teste si la variable a été initialisée
'si ce n'est pas le cas, le classeur n'existe
'pas encore, alors le crée
On Error Resume Next
If IsError(ClasseurDuJour.Name) Then
Set ClasseurDuJour = Workbooks.Add
ClasseurDuJour.SaveAs ThisWorkbook.Path & "" & LeJour
'il est possible de cacher le classeur pour
'éviter l'encombrement
'pour l'afficher : Fenêtre|Afficher...
'***Windows(LeJour).Visible = False
End If
'les valeurs sont copiées par l'intermédiaire
'd'un tableau, d'un classeur dans l'autre avec
'écrasement des anciennes valeurs au cas où il
'y a eue modif, de cette façon, les 2 feilles
'sont identiques
CollerValeurs ClasseurDuJour, ThisWorkbook
'enregistre
ClasseurDuJour.Save

Application.ScreenUpdating = True
Set ClasseurDuJour = Nothing
End Sub

Sub CollerValeurs(ClasseurDuJour As Workbook, _
ClasseurToTo As Workbook)
Dim Tbl
Dim Ligne As Long
Dim Colonne As Long
'Attention ! les deux feuilles s'appellent "Feuil1"
'adapter le cas échéant
'défini la zone et la récupère dans un tableau
With ClasseurToTo.Worksheets("Feuil1")
Ligne = .Cells.Find("*", .[A1], xlFormulas, , _
xlByRows, xlPrevious).Row
Colonne = .Cells.Find("*", .[A1], xlFormulas, , _
xlByColumns, xlPrevious).Column
Tbl = .Range(.Cells(1, 1), .Cells(Ligne, Colonne))
End With
'colle le tableau dans la feuille du classeur du jour
With ClasseurDuJour.Worksheets("Feuil1")
.Range(.Cells(1, 1), .Cells(Ligne, Colonne)) = Tbl
End With

Erase Tbl
End Sub

Function Fichiers(Dossier As String) As String()
Dim TblFichiers() As String
Dim I As Long
'retourne tous les fichiers du dossier
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
'retourne tous les fichiersExcel
.Filename = "*.xls"
.LookIn = Dossier
.SearchSubFolders = False
.Execute
With .FoundFiles
'si aucun fichier met Annuler à True, puis fin
If .Count = 0 Then
Exit Function
End If
ReDim TblFichiers(1 To .Count)
For I = 1 To .Count
TblFichiers(I) = Dir(.Item(I))
Next I
End With
End With
Fichiers = TblFichiers

Erase TblFichiers
End Function

'-------------------------------------------------------
'A mettre dans le module du classeur Toto.xls (ThisWorkbook)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
Enregistrer
End Sub
'--------------------------------------------------------
La proc fonctionne de la manière suivante :
Une fois le classeur Toto.xls ouvert, à chaque enregistrement de celui-ci,
le classeur du jour est recherché sur le disque dans le dossier où est
enregistré Toto.xls, si le classeur existe, l'ouvre si ce n'est pas déjà
fait, puis colle les valeurs de la feuille "Feuil1" du classeur Toto.xls
dans la feuille "Feuil1" du classeur du jour et l'enregistre.
Fais attention au nom de la feuille du classeur Toto.xls, dans la proc Feuil1

Hervé

"William" <brun_rhodanienne@hotmail.com> a écrit dans le message news:
uSRXzmBYEHA.3016@tk2msftngp13.phx.gbl...

Bonjour,

Dans une feuille toto.xls, je souhaiterai mettre un bouton « Enregistrer »
qui permettrait, certes d'enregistrer mais de le faire en créant une copie
jourJ.xls du fichier Excel dans un répertoire du disque dur avec pour nom
de

fichier la date du jour, pour la première fois que je clique sur le
bouton.

Puis d'enregistrer sur ce fichier jourJ.xls toute la journée sur des
lignes

d'enregistrement différents à chaque clic sur ce bouton.
Le lendemain, toujours en ouvrant mon fichier toto.xls, j'enregistre dans
JourJ+1.xls

Le but étant d'avoir toto.xls comme formulaire d'enregistrement et
JourJ+n.xls comme fichiers de sauvegarde

Si quelqu'un a une idée plus simple ou plus pratique, je suis complètement
ouvert aux propositions.

A noter que si j'enregistrais toutes mes données sur plusieurs jours mais
sur un seul fichier jours.xls, j'ai peur que ce fichier devienne trop gros
et qu'il faille 3 plombes pour l'utiliser.


William