Bonjour à tous,
Tout d'abord je tiens à remercier tous les intervenants sur ce forum qui m'a beaucoup aider et dans lequel j'ai toujours pu trouver des astuces.
Je ne suis pas très fort en VBA mais j'arrive assai régulièrement à modifier des codes trouvé sur la toile pour réaliser mon travail.
Je continue a apprendre lentement.
Voici mon problème:
J'ai créé un fichier pour les plannings de mon personnel, je l'ai édite tous par une macro avec le nom de chaque employé.
Cela fonctionne très bien mais il me faut ranger tout ces fichiers dans des dossiers et j'aimerais le faire automatiquement.
A l'heure actuelle sur la page "Employés" lorsque j'appuie sur le bouton Générer tous les calendriers, il me crée un dossier avec comme nom l'année et il me mets tous les fichiers dedans avec le nom qui se trouve dans la colonne H
Je voudrais que sur le bouton "Générer par services" il me crée également tous les sous dossier se trouvant dans la colonne G "Services" et qu'il fasse le tri automatiquement
Autre problème que je rencontre l'affichage des boutons ne se fait pas correctement à l'ouverture du fichier, je suis obligé de faire un clic droit dessus
le fichier :V_15.8 - test dossier - Copie.xlsm

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Private Sub CommandButton1_Click()
Dim Fe As Worksheet
With ListObjects(1).Range 'tableau structuré
    Dim chemin$, dossier$, fichier$, i&
    chemin = ThisWorkbook.Path & "\"
    dossier = chemin & "Planning news\"
    If Dir(dossier, vbDirectory) = "" Then MkDir dossier 'création du dossier
    '---suppression des fichiers---
    fichier = Dir(dossier & "*.xlsm")
    On Error Resume Next
    While fichier <> ""
        Workbooks(fichier).Close False 'si l'un des fichiers est ouvert on le ferme
        Kill dossier & fichier
        fichier = Dir
    Wend
    On Error GoTo 0
    '---création des fichiers .xlsm---
    Application.DisplayAlerts = False
    fichier = ThisWorkbook.FullName 'mémorise
    For i = 2 To .Rows.Count
        '---Copie des matricules dans les enregistrements de fichiers---
        Sheets("Calendrier").Range("B5") = .Cells(i, 1)
 
       '---Vérrouillage fichier à sauvegarder---
 
        Sheets("Log changements").Range("C2").Value = "Verrouillage Actif"
Sheets("Log changements").Range("C2").Font.ColorIndex = 3
 
    For Each Fe In Sheets
        'If Fe.Name = "Log changements" And Fe.Name = "Calendrier" Then Fe.Protect "letalcestblanc"
        If Fe.Name <> "Log changements" And Fe.Name <> "Calendrier" Then Fe.Visible = False
    Next Fe
 
    Sheets("Log changements").Protect "letalcestblanc"
    Sheets("Calendrier").Activate
    Sheets("Calendrier").Protect "letalcestblanc"
    ActiveWorkbook.Protect "letalcestblanc"
 
'---Copie du fichier avec nom---
        If .Cells(i, 7) <> "" Then ThisWorkbook.SaveAs dossier & .Cells(i, 7) & " " & Range("K1") & ".xlsm", 52 'fichier .xlsm
 
       '---Deprotection fichier actif---
 
       ActiveWorkbook.Unprotect "letalcestblanc"
For Each fc In Worksheets
        fc.Visible = xlSheetVisible
        fc.Unprotect "letalcestblanc"
    Next
    Sheets("Log changements").Range("C2").Value = "Verrouillage Inactif"
Sheets("Log changements").Range("C2").Font.ColorIndex = 4
Sheets("Log changements").Activate
    Next
 
 
End With
ThisWorkbook.SaveAs fichier, 52 'fichier .xlsm
End Sub