Créer un dossier nommé avec date

Bonjour le forum

J’utilise le code ci-dessous qui marche tés bien, son rôle est exporter une feuille nommée « Base » pour la renommée sous un autre nom « Sauvegarde-Base-GRIE + date d’aujourd’hui » dans un emplacement choisi par l’utilisateur.

Ce que je souhaite faire c’est créer en même temps un dossier nommée exemple

« Sauvegarde vendredi 02 décembre 2022 » et y placer la feuille exportée.

J’ai essayé en ajoutant des lignes dans ma macro pour créer ce dossier mais sans succès

Que dois-je ajouter à ce code pour réaliser ce but ?

Je vous remercie d’avance pour votre aide en espérant que cela soit possible.

Cordialement

Sub export_b()
Dim wkb As Workbook, nm As Name
Dim NomNWs As String
Dim NomNWb As String
Dim Repertoire As String
Dim Ws As Worksheet
Dim madate

On Error GoTo errorHandler
Application.ScreenUpdating = False

    MsgBox ("Vous devez indiquer le repertoire ou sera enregistré le fichier")
    Repertoire = ChoixDossier  'demande a l'utilisateur de saisir le repertoire ou se trouve le fichier
    If Repertoire = "" Then Exit Sub
    Application.DisplayAlerts = False

  madate = Format(Now, "dddd dd mmmm yyyy")
  NomNWs = "Tb_Infos"
  NomNWb = "Sauvegarde-Base-GRIE"

With ActiveSheet
    .Unprotect Password:="Recap"
    .Copy
    .Protect Password:="Recap"
End With

   With ActiveWorkbook
            With Sheets("Base")
                .Shapes.Range(Array("curseur", "Rectangle 2")).Delete    '"Rectangle 3", "Rectangle 4"

                .Range("B3").Select
                  ActiveWindow.FreezePanes = False
                .Name = NomNWs 'ou  --> ThisWorkbook.Sheets("Base").Range("P1")
            End With

          'Suppression des noms exportés dans le nouveau classeur
        Set wkb = ActiveWorkbook
            On Error Resume Next
            For Each nm In wkb.Names
              nm.Delete
            Next nm

    .SaveAs Repertoire & "\" & NomNWb & "-" & madate & ".xlsx"
    .Close
   End With

MsgBox "La base de donnée du logiciel est exportée vers : " & Repertoire & "\Sauvegarde-Base-GRIE.xls", vbInformation, "CONFIRMATION"
Application.DisplayAlerts = True

Exit Sub
errorHandler:
Application.ScreenUpdating = True
End Sub

Hello,

la manière la plus simple est celle-ci :

    Const strchemin As String = "C:\Users\VBA\"
    Dim strhorodatage As String

    strhorodatage = "Sauvegarde " & Format(Now, "dddd dd mmmm yyyy")

    MkDir strchemin & strhorodatage

Dans ton code ça pourrait donner :

On Error GoTo errorHandler
Application.ScreenUpdating = False

    MsgBox ("Vous devez indiquer le repertoire ou sera enregistré le fichier")
    Repertoire = ChoixDossier  'demande a l'utilisateur de saisir le repertoire ou se trouve le fichier
    If Repertoire = "" Then Exit Sub
    Application.DisplayAlerts = False

  madate = Format(Now, "dddd dd mmmm yyyy")
  NomNWs = "Tb_Infos"
  NomNWb = "Sauvegarde-Base-GRIE"

  MkDir Repertoire & madate

bonsoir Rag02700 bonsoir le forum

Super merci je vais essayer