Sub Dupliquer_Tableau()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim ES As FileDialog 'déclare la variable ES (Enregistre Sous)
Dim ND As Byte 'déclare la variable ND (Nombre d'onglet par Défaut)
Set CS = ThisWorkbook 'définit la classeur source CS
ND = Application.SheetsInNewWorkbook 'récupère dans la variable ND le nombre d'onglets vierges par défaut dans un nouveau classeur
Application.SheetsInNewWorkbook = 1 'redéfinit le nombre d'onglets vierges par défaut dans un nouveau classeur
Set CD = Workbooks.Add 'définit le classeur destination CD en ouvrant un nouveau classeur
chemin = ThisWorkbook.Path & "\Tableau\" 'définit le chemin
pj = CDate("1 - " & Month(Date))
dj = Format(Application.EoMonth(pj, 0), """ ""dd/mm/yyyy")
Dates = InputBox("Saisir date début et date de fin" & Chr(13) & "(séparée par un espace)", "Création Effectif Journalier", pj & dj)
'Dates = InputBox("Saisir date début et date de fin" & Chr(13) & "(séparée par un espace)", "Création Effectif Journalier") 'si tu ne veux pas de date de départ défini
Select Case True
Case StrPtr(Dates) = 0
Exit Sub
Case Len(Dates) = 0
Exit Sub
Case Else
Application.ScreenUpdating = False
i = CDate(Split(Dates)(0))
j = CDate(Split(Dates)(1))
For x = i To j
CS.Worksheets("Tableau").Copy after:=CD.Sheets(Worksheets.Count) 'copie l'onglet "Tableau" du classeur source après le premier onglet du classeur destination
With ActiveSheet
.Range("B4").Value = CDate(x)
.Name = Format(x, """Tableau du ""dd-mm-yyyy")
.DrawingObjects.Delete
End With
Next x
End Select
Application.DisplayAlerts = False 'masque les message d'Excel
CD.Sheets(1).Delete 'supprime le premier onglet du classeur destination
Application.DisplayAlerts = True 'affiche lkes message d'excel
CD.Worksheets(1).Activate 'active le premier onglet du classeur destination
Application.SheetsInNewWorkbook = ND 'redéfinit le nombre d'onglet par défaut d'un nouveau classeur tel qu'il était initialement
Set ES = Application.FileDialog(msoFileDialogSaveAs) 'définit ES (boîte de dialogue Enregistrer Sous)
ES.InitialFileName = chemin 'définit le chemin par défaut de la boîte de dialogue
ES.Show 'affiche ES
If ES.SelectedItems.Count > 0 Then ActiveWorkbook.SaveAs ES.SelectedItems(1) 'si un nom a été inscrit et validé, enregistre sous le classeur destination
End Sub