Discussion :

[jpg35]

Bonjour à tous,

J'ai un petit soucis.

Je travaille depuis plusieurs mois sur un classeur excel "recette standard" que je duplique pour créer différentes recettes indépendantes.

Tous rangés dans un même dossier.

Aujourd'hui, j'ai ajouté une feuille dans mon classeur "recette standard" que j'aimerais copier dans mes recettes existantes, tout ceci sans liaison bien sûr !

Je me suis risqué à un code en essayant de déchiffrer d'autres macros qui se rapprochent un peu de l'utilité que je veux en faire.

Mais vous allez vite vous rendre compte que je suis totalement novice !

Voici ce que je propose:

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
 
Option Explicit
 
Dim FichierPrincipal As Workbook
 
Sub CompilRecettes()
 
Dim fs
Dim chemin As Folder
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set chemin = fs.GetFolder(ThisWorkbook.Path)
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set FichierPrincipal = ThisWorkbook
    Call scan(chemin)
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
End Sub
 
Sub scan(ByVal Dossier As Folder)
 
Dim Fichier As File
Dim Sousdossier As Folder
Dim Classeur As Workbook
 
    For Each Fichier In Dossier.Files
        Select Case Right(Fichier, 3)
            Case "xls", "lsx", "lsm", "lsb"
                If Left(Fichier.Name, 1) <> "~" And Not (Fichier.Name Like "*Recette standard*") Then
                    Workbooks.Open Fichier
                    Set Classeur = ActiveWorkbook
                        ActiveWorkbook.Sheets(4).Select
                        FichierPrincipal.Activate
                        Selection.Copy
                    End If
 
                    Classeur.Close False
                End Ifhttps://forum.excel-pratique.com/post/nouveau/2#
        End Select
    Next Fichier
 
    For Each Sousdossier In Dossier.SubFolders
        Call scan(Sousdossier)
    Next
 
End Sub

Merci pour votre aide !

jp