Sub CopieFeuilles_et_TCD()
Dim shModele_Tasks As Worksheet
Dim shModele_WeekPage As Worksheet
Dim sNouveauNom_Tasks$
Dim sNouveauNom_WeekPage$
Dim shNouveauNom_Tasks As Worksheet
Dim shNouveauNom_WeekPage As Worksheet
Dim iWeekno As Integer
' Memoriser les feuilles modèles / Memorize template worksheets
Set shModele_Tasks = Worksheets("Taches à réaliser agence APO")
Set shModele_WeekPage = Worksheets("S ..")
'Sheets(Array(shModel_Tasks, shModel_WeekPage)).Copy after:=Sheets.Count
' Mémoriser le numéro de semaine / Get week no.
iWeekno = IsoWeekNum(Now)
' Préparer les nouveaux noms / Prepare new names
sNouveauNom_Tasks = shModele_Tasks.Name & "-" & iWeekno
sNouveauNom_WeekPage = shModele_WeekPage.Name & "-" & iWeekno
sTasks_TableName = "Tableau-S" & iWeekno
' Copier la feuille de calcul modèle hebdomadaire
' Copy template of weekly worksheet for pivot table
' sauf si elle existe déjà / except if it already exists
shModele_WeekPage.Activate
If WSH_Exists(sNouveauNom_WeekPage) = False Then
ActiveSheet.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = sNouveauNom_WeekPage
'Set shNouveauNom_WeekPage = ActiveSheet
End If
Set shNouveauNom_WeekPage = Worksheets(sNouveauNom_WeekPage)
' Copier la feuille de calcul modèle pour les tâches
' Copy template worksheet for data
' sauf si elle existe déjà / except if it already exists
shModele_Tasks.Activate
If WSH_Exists(sNouveauNom_Tasks) = False Then
ActiveSheet.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = sNouveauNom_Tasks
'Set shNouveauNom_Tasks = ActiveSheet
End If
Set shNouveauNom_Tasks = Worksheets(sNouveauNom_Tasks)
' Créer un objet Tableau à partir des données / Create a table (listobject) from data
With shNouveauNom_Tasks
If .FilterMode = True Then .ShowAllData
If .ListObjects.Count = 0 Then
.ListObjects.Add(xlSrcRange, .Range("$A$1:$S$1").Resize(Application.CountA(.Columns(1))), , xlYes).Name = _
"Tableau-S" & iWeekno
Else
' .ListObjects(1).DataBodyRange.Resize (Application.CountA(.Columns(1)))
.ListObjects(1).Resize .ListObjects(1).Range.Resize(Application.CountA(.Columns(1)))
' rename list object if required
If .ListObjects(1).Name <> sTasks_TableName Then .ListObjects(1).Name = sTasks_TableName
End If
.ListObjects(1).TableStyle = ""
End With
' Changer la source de données de la feuille de calcul hebdomadaire
' Switch data source to new worksheet
With shNouveauNom_WeekPage
.PivotTables(1).ChangePivotCache _
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=shNouveauNom_Tasks.ListObjects(1).Range, Version:=6)
End With
End Sub
Public Function IsoWeekNum(d1 As Date) As Integer
' Provided by Daniel Maher.
Dim d2 As Long
d2 = DateSerial(Year(d1 - Weekday(d1 - 1) + 4), 1, 3)
IsoWeekNum = Int((d1 - d2 + Weekday(d2) + 5) / 7)
End Function
Public Function WSH_Exists(SheetName As String) As Boolean
On Error Resume Next
WSH_Exists = Not (Sheets(SheetName) Is Nothing)
End Function