XL 2016 Renommer un classeur par un nom différent a chaque fois.

[headskull]

Bonjour a toutes et tous je suis nouveau et debutant, je rame depuis quelques semaines a trouver comment a partir d'un classeurs renommer "compteur S01"
pouvoir renommer un classeur vierge de valeurs "compteur vierge" dans le même dossier mais renommer "compteur S02" et la semaine suivant "compteur S03" et ainsi de suite.

Toutes les semaines nous rentrons des valeurs dans un classeur et a la fin de la semaine j'aimerai crée une nouvelle semaine renommée différemment pour garder un suivi.

je sais que c'est possible, je l'ai deja vue mais pas reussi a voir le code.

Merci d'avance pour votre aide.

 

[Efgé]

Bonjour headskull

Si j'ai bien compris:
Une proposition qui sauvegarde le classeur ouvert dans le même dossier avec le numéro de la semaine ISO du jour de la sauvegarde.

Sub test()
Dim Sem$
Sem = Format(NoSem(Date), "00")
Application.DisplayAlerts = False 'pour éviter le message
ThisWorkbook.SaveAs ThisWorkbook.Path & "/compteur " & Sem & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
End Sub
'________________________________________________
Function NoSem(d As Date) As Long
'L. Longre
   d = Int(d)
   NoSem = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)
   NoSem = ((d - NoSem - 3 + (Weekday(NoSem) + 1) Mod 7)) \ 7 + 1
End Function

Cordialement

 

[job75]

Bonjour headskull, bienvenue sur XLD, bonjour Efgé,

Sur Excel 2016 la fonction NO.SEMAINE.ISO existe forcément donc utiliser simplement :

Sub test()
Dim sem$
sem = Format(Application.IsoWeekNum(Date), "\S00")
Application.DisplayAlerts = False 'pour éviter le message
ThisWorkbook.SaveAs ThisWorkbook.Path & "\compteur " & sem & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

A+

 

[headskull]

Bonjour Efgé,

d'abord merci pour ta réponse, et je vais tester voir si ça pourrai aller,
mais j'avais pensé a renommer un classeur déja pres avec juste la mise en forme (vierge de données) ce qui m'éviterai de supprimer les donnees pour le nouveau classeurs .

Cordialement,

 

[headskull]

Bonjour Job,

merci pour ta réponse, oui en effet ton code fonctionne, mais j'aimerai pouvoir copier le classeur prés a l'emplois renommé lui "compteur vierge"
merci en tous cas vous assurés je commence a voir le bout du tunnel

cordialement

 

[job75]

Re,

Bon OK, voyez les fichiers joints avec cette macro dans ThisWorkbook :

Private Sub Workbook_Open()
Dim sem$, fichier$, ouvre As Boolean
sem = Format(Application.IsoWeekNum(Date), "\S00")
fichier = Me.Path & "\compteur " & sem & ".xlsm"
If Dir(fichier) <> "" Then Exit Sub
If MsgBox("Créer le fichier " & fichier & " ?", 4) = 7 Then Exit Sub
If LCase(Me.Name) <> "compteur vierge.xlsm" Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'évite de déclencher la Workbook_Open
    Workbooks.Open Me.Path & "\compteur vierge"
    Application.EnableEvents = True
    ouvre = True
End If
ActiveWorkbook.SaveAs fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
[A1] = sem: ActiveWorkbook.Save 'pour tester
If ouvre Then Me.Close True
End Sub

Elle se déclenche automatiquement quand on ouvre l'un ou l'autre classeur.

A+