Création de feuilles de travail quotidiennes, archivage des feuilles de travail des semaines précédentes

Question

J'essaie de comprendre comment archiver des feuilles de calcul d'une semaine.

Un peu de fond sur mon projet:

Je crée deux nouvelles feuilles chaque jour qui abritent des résumés de rapports quotidiens et les calculs que je critique sur une base quotidienne. À l'heure actuelle, il y a beaucoup trop de feuilles de calcul ouvertes dans le fichier Excel, il faut donc une éternité pour les ouvrir et les envoyer aux gens. En fin de compte, je voudrais savoir comment enregistrer les feuilles de calcul qui ont été créées la semaine précédente dans un autre fichier. Je voudrais les enregistrer tous dans un classeur séparé (single), ou créer un dossier pour chaque classeur pour chaque jour de la semaine. Ainsi, par exemple, je crée 10 feuilles de travail pour la semaine en cours (2 pour chaque jour de la semaine, du lundi au vendredi). Puis, quand je viendrai le lundi suivant et que je commencerai à créer les feuilles de travail pour cette semaine, les anciennes feuilles seront placées dans un autre classeur.

Le code que j'utilise actuellement pour créer les fiches de travail tous les jours:

TD = Format(Date, "yyyy.mm.dd") 

On Error GoTo Make_Sheet 
    Sheets("Open_" & TD).Activate 

    Sheets("Open_" & TD).Select 
    Cells.Select 
    Selection.Delete Shift:=x1Up 
Exit Sub 

    Make_Sheet: 
     Worksheets.Add(After:=Sheets("Print")).Name = "Open_" & TD 
     ActiveSheet.Name = "Open_" & TD 

With ActiveWorkbook.Sheets("Open_" & TD).Tab 
    .Color = 5296274 
    .TintAndShade = 0 
End With 

Le code vérifiera si la feuille de date existe déjà (en utilisant la date comme le titre de la feuille de calcul), si elle cela efface-t-il. Sinon, il créera la nouvelle feuille de calcul. Il va également coder en couleur l'onglet (puisque j'en crée 2 chaque jour). J'ai un autre ensemble identique de code pour créer la deuxième feuille de travail quotidienne.

Merci à l'avance,

-Tuques

Answer 1

Voici une macro pour copier toutes les feuilles à un nouveau classeur, enregistrez et fermez le nouveau classeur. Supprimez toutes les feuilles sauf la première, puis effacez le contenu de la feuille restante. Vous ne savez pas exactement quelles feuilles vous souhaitez conserver.

Sub New_week() 
NWeek = MsgBox("Is this the start of a new week?", vbYesNo + vbQuestion) 

    If NWeek = 6 Then 

     Dim fname As String 
     'Create new Workbook name. 
     'Add path if you want it in a specific folder 
    fname = "Week" & Format(Date, "yyyy_mm_dd") & ".XLSX" 
     'copy all sheets 
    Sheets.Copy 
     'save to new file 
     With ActiveWorkbook 
     .SaveAs FileName:=fname, FileFormat:=xlOpenXMLWorkbook 
     .Close SaveChanges:=False 
     End With 

    'Delete all sheets except first 
    Application.DisplayAlerts = False 
     Do While Worksheets.Count > 1 
     Worksheets(2).Delete 
     Loop 
    Application.DisplayAlerts = True 
    'Clear contents of first sheet 
    Sheets(1).UsedRange.Clear 

    End If