Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Morgane

XLDnaute Nouveau
Bonjour à tous,

J'ai un soucis sur la macro que je viens d'adapter pour mes besoins. Etant un néophyte en macro excel, je fait appel à votre expérience et votre sympathie pour voir si vous pouvez faire quelque chose pour moi :confused:

La code qui suit est censé ouvrir chaque dossiers et sous dossiers pour ensuite ouvrir les fichiers qui y sont contenus afin de les mettre à jour via un procédure contenu dans le code (MAJ_fichier).

Cependant, je n'ai pas l'impression que cela fonctionne correctement, en effet, lorsque je lance la procédure, la première parti fonctionne bien (séléction du dossier à traiter) mais c'est ensuite que ça se gate. Le traitement ne fait pas ce que je veux. Je vois bien que mon PC travail, mais je ne sais pas ce qu'il fait car la mise à jour ne se fait pas.

Je sais que les routines suivantes fonctionnent car déjà utilisées (mais pas dans une macro) :

- Sub prepa_factu_presta()
- Sub prepa_factu_transp()
- Sub prepa_factu_CDC()

Je pense que la procédure Sub Choisir_Fichier() fonctionne car le navigateur m'ouvre bien une boite de dialogue pour séléctionner un dossier à traiter.

Le problème est surement sur la procédure Sub Ouvrir_Fichier (enfin je crois ?)

Cette macro est dans un module sur un classeur "de pilotage" qui possède uniquement cette macro.

Voici le code :

PHP:
Option Explicit

Dim Fso As Scripting.FileSystemObject
Dim Nomdossiers As Scripting.Folders
Dim Nomfichiers As Scripting.Files
Dim ApplSelectionDossier As FileDialog

Sub Choisir_Fichier()

'Création de la boite de dialogue
Set ApplSelectionDossier = Application.FileDialog(msoFileDialogFolderPicker)

'Choix du dossier
With ApplSelectionDossier

    'Titre de la boite de dialogue
    .Title = "Selectionnez un dossier"

    'L'utilisateur à cliqué sur le bouton OK de la boite de dialogue
    If .Show = -1 Then

        'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
        
        'Affecte la liste des sous dossiers du dossier sélectionné
        Set Nomdossiers = Fso.GetFolder(.SelectedItems(1)).SubFolders
        
        'Affecte la liste des fichiers du dossier en-cours
        Set Nomfichiers = Fso.GetFolder(.SelectedItems(1)).Files
        
        'Appel de la procédure d'ouverture des fichiers
        Call Ouvrir_Fichier(Nomdossiers, Nomfichiers)
        
    'L'utilisateur à cliqué sur le bouton annuler
    Else
    
    End If
    
End With

End Sub

PHP:
Sub Ouvrir_Fichier(Nomdossiers As Scripting.Folders, Nomfichiers As Scripting.Files)

Dim Nomdossier As Scripting.Folder
Dim Nomfichier As Scripting.File


If Nomfichiers Is Nothing Then

Else

    'Pour chaque fichier de la liste de fichiers
    For Each Nomfichier In Nomfichiers
    
        'Si L'extension du fichier est .xslx ou .xslm
        If Right(Nomfichier, 5) = "xslx" Or Right(Nomfichier, 5) = "xslm" Then
        
            'Ouvrir le fichier
            Workbooks.Open Filename:=Nomfichier
        
Call MAJ_fichiers

            'Enregistrer avant de fermer
            ActiveWorkbook.Save
        
            'Ferme le fichier
            ActiveWorkbook.Close
        
        End If
        
    Next
    
End If

If Nomdossiers Is Nothing Then

Else

        'Pour chaque dossier de la liste de dossiers
        For Each Nomdossier In Nomdossiers
        
        'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
        
        'Affecte la liste des fichiers du dossiers en cours
        Set Nomfichiers = Fso.GetFolder(Nomdossier.Path).Files
        
        'Appel la procédure d'ouverture des fichiers (récursif)
        Call Ouvrir_Fichier(Nomdossier.SubFolders, Nomfichiers)
        
    'Dossier suivant
    Next Nomdossier
    
End If

End Sub

PHP:
Sub MAJ_fichiers()

Worksheets(1).Unprotect Password:="admin"

    Select Case ("Sujet")
        Case Left("Sujet", 3) = "PRE"
            Call prepa_factu_presta
        Case Left("Sujet", 3) = "TRA"
            Call prepa_factu_transp
        Case Left("Sujet", 3) = "CDC"
            Call prepa_factu_CDC
        Case Else
            MsgBox "Pas de traitement"
    End Select
    
Worksheets(1).Protect Password:="admin"

End Sub

PHP:
Sub prepa_factu_presta()
    
' prepa_factu Macro

    Worksheets(1).Unprotect Password:="admin"
    Range("A2").Select
    Selection.ClearContents
    Range("F4").Select
    ActiveCell.Value = "7/31/2012"
    Range("H5").Select
    ActiveCell.Value = "PRESTATION JUILLET 2012"
 
    Range("M").Select
    Selection.Copy
    Range("M_1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Del").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Worksheets(1).Protect Password:="admin"
    
    MsgBox ("Yeaah all wright !")
    
End Sub

PHP:
Sub prepa_factu_transp()
    
' prepa_factu Macro

    Worksheets(1).Unprotect Password:="admin"
    Range("A2").Select
    Selection.ClearContents
    Range("F4").Select
    ActiveCell.Value = "7/31/2012"
    Range("H5").Select
    ActiveCell.Value = "TRANSPORT JUILLET 2012"
 
    Range("M").Select
    Selection.Copy
    Range("M_1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Quantite").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Worksheets(1).Protect Password:="admin"
    
    MsgBox ("Yeaah all wright !")
    
End Sub

PHP:
Sub prepa_factu_CDC()
    
' prepa_factu Macro

    Worksheets(1).Unprotect Password:="admin"
    Range("A2").Select
    Selection.ClearContents
    Range("F4").Select
    ActiveCell.Value = "7/31/2012"
    Range("H5").Select
    ActiveCell.Value = "CDC JUILLET 2012"
 
    Range("M").Select
    Selection.Copy
    Range("M_1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Quantite").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Worksheets(1).Protect Password:="admin"
    
    MsgBox ("Yeaah all wright !")
    
End Sub

Si vous avez des remarques ou quoi que ce soit, je suis preneur et surtout si vous avez des solutions à m'apporter, je vous en serait très reconnaissant.

Merci à tous.
 

Pièces jointes

  • Pilotage MAJ.xlsm
    21.3 KB · Affichages: 54
  • FAC Trsp code cli 2012-07.xlsm
    29 KB · Affichages: 50
  • FAC Presta code cli 2012-07.xlsm
    33.1 KB · Affichages: 64
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Bonjour

Aie! mes yeux !

Bonjour à tous,
Si vous avez des remarques ou quoi que ce soit, je suis preneur et surtout si vous avez des solutions à m'apporter, je vous en serait très reconnaissant. Merci à tous.
Précisions demandées:
La référence à Microsoft Scripting Runtime est bien cochée dans VBE?
(ALT+F11 puis Outils/Références)

NB: J'ai supprimer l'emploi des Select dans certaines de tes macros (Il est rarement utile de les employer dans une macro)

Stp, édites ton premier message (cliques sur Modifier le message), et ajoutes les balises:
[NOPARSE]
Code:
Texte de la macro
[/NOPARSE] pour obtenir l'affichage suivant:
Merci
Code:
Option Explicit
Dim Fso As Scripting.FileSystemObject
Dim Nomdossiers As Scripting.Folders
Dim Nomfichiers As Scripting.Files
Dim ApplSelectionDossier As FileDialog

Sub Choisir_Fichier()
'Création de la boite de dialogue
Set ApplSelectionDossier = Application.FileDialog(msoFileDialogFolderPicker)
'Choix du dossier
With ApplSelectionDossier
    'Titre de la boite de dialogue
    .Title = "Selectionnez un dossier"
    'L'utilisateur à cliqué sur le bouton OK de la boite de dialogue
    If .Show = -1 Then
        'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
        'Affecte la liste des sous dossiers du dossier sélectionné
        Set Nomdossiers = Fso.GetFolder(.SelectedItems(1)).SubFolders
        'Affecte la liste des fichiers du dossier en-cours
        Set Nomfichiers = Fso.GetFolder(.SelectedItems(1)).Files
        'Appel de la procédure d'ouverture des fichiers
        Call Ouvrir_Fichier(Nomdossiers, Nomfichiers)
    'L'utilisateur à cliqué sur le bouton annuler
    Else
    End If
End With
End Sub
Code:
Sub Ouvrir_Fichier(Nomdossiers As Scripting.Folders, Nomfichiers As Scripting.Files)
Dim Nomdossier As Scripting.Folder
Dim Nomfichier As Scripting.File
If Nomfichiers Is Nothing Then
Else
    'Pour chaque fichier de la liste de fichiers
    For Each Nomfichier In Nomfichiers
        'Si L'extension du fichier est .xslx ou .xslm
        If Right(Nomfichier, 5) = "xslx" Or Right(Nomfichier, 5) = "xslm" Then
            'Ouvrir le fichier
            Workbooks.Open Filename:=Nomfichier
Call MAJ_fichiers
            'Enregistrer avant de fermer
            ActiveWorkbook.Save
            'Ferme le fichier
            ActiveWorkbook.Close
        End If
    Next
End If
If Nomdossiers Is Nothing Then
Else
        'Pour chaque dossier de la liste de dossiers
        For Each Nomdossier In Nomdossiers
        'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
        'Affecte la liste des fichiers du dossiers en cours
        Set Nomfichiers = Fso.GetFolder(Nomdossier.Path).Files
        'Appel la procédure d'ouverture des fichiers (récursif)
        Call Ouvrir_Fichier(Nomdossier.SubFolders, Nomfichiers)
    'Dossier suivant
    Next Nomdossier
End If
End Sub
Code:
Sub MAJ_fichiers()
Worksheets(1).Unprotect Password:="admin"
    Select Case ("Sujet")
        Case Left("Sujet", 3) = "PRE"
            Call prepa_factu_presta
        Case Left("Sujet", 3) = "TRA"
            Call prepa_factu_transp
        Case Left("Sujet", 3) = "CDC"
            Call prepa_factu_CDC
        Case Else
            MsgBox "Pas de traitement"
    End Select
Worksheets(1).Protect Password:="admin"
End Sub
Code:
Sub prepa_factu_presta()
' prepa_factu Macro
    Worksheets(1).Unprotect Password:="admin"
    Range("A2").ClearContents
    Range("F4")= "7/31/2012"
    Range("H5")= "PRESTATION JUILLET 2012"
    Range("M").Copy
    Range("M_1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Del").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Worksheets(1).Protect Password:="admin"
    MsgBox ("Yeaah all wright !")
End Sub
Code:
Sub prepa_factu_transp()
' prepa_factu Macro
    Worksheets(1).Unprotect Password:="admin"
    Range("A2").ClearContents
    Range("F4")= "7/31/2012"
    Range("H5")= "TRANSPORT JUILLET 2012"
    Range("M").Copy
    Range("M_1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Quantite").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Worksheets(1).Protect Password:="admin"
    MsgBox ("Yeaah all wright !")
End Sub
Code:
Sub prepa_factu_CDC()
  ' prepa_factu Macro
    Worksheets(1).Unprotect Password:="admin"
    Range("A2").ClearContents
    Range("F4")= "7/31/2012"
    Range("H5")= "CDC JUILLET 2012"
    Range("M").Copy
    Range("M_1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Quantite").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Worksheets(1).Protect Password:="admin"
    MsgBox ("Yeaah all wright !")
  End Sub
Ouf Mes yeux ;)

PS: Le mot de passe est d'une sécurité très très élevée ;)
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

RE


Pour pouvoir faire des tests, il serait utile de joindre 1,2 ou 3 petits fichiers exemples anonymisés et le fichier contenant la macro de MAJ
Zippes ces 4 fichiers et postes-les sur le forum.
 

Morgane

XLDnaute Nouveau
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Bonjour Staple1600,

Merci pour les infos, j'ai donc fait les modifs que tu me demandais sur mon message original.

Sinon pour répondre à ta question (ci dessous) Oui, il est bien coché.

Précisions demandées:
La référence à Microsoft Scripting Runtime est bien cochée dans VBE?
(ALT+F11 puis Outils/Références)

Sinon pour plus de précision, j'ai mis en PJ des fichiers anonymisés. Il sont rangés dans l'ordre suivant :

Dossier [période]
Sous dossier [Type Client]
Sous dossier [Client]
Fichier presta
Fichier transp

Le but de la macro ci dessus est de mettre à jour tous ce fichiers en un clic :cool:.

Merci pour ces précisions en tout cas.

Cordialement
Morgane.
 

Staple1600

XLDnaute Barbatruc
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Bonjour


LOL: Cacher une feuille, c'est pas vraiment l'anonymiser ;) (cf M. Alexandre H.)

Pour être sûr:
Quels fichiers se trouvent dans les sous-dossiers Client et Type Client?
Voila comment j'ai compris ton dernier message
(Sur mon PC, les deux sous-dossiers sont vides) -> cf copie d'écran ci-dessous:
arbo.png

Tu peux confirmer ou pas si cette arborescence est la bonne?

Merci.
 

Morgane

XLDnaute Nouveau
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Staple1600,

LOL, je viens de supprimer cette feuille cachée !

Sinon l'arborescence est comme cela :

[Période] => [Type Client] => [Client] => Fichiers

En fait les fichiers sont en bout de chaine des dossiers et sous dossiers (signialés par les [])
 

Staple1600

XLDnaute Barbatruc
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Bonsoir


Ce soir j'ai pas trop le temps de pousser plus loin l'investigation
Mais je crois deviner que le souci se situe ici peut être
'Ouvrir le fichier
Workbooks
.Open Filename:=Nomfichier

Call MAJ_fichiers <------ Ici

'Enregistrer avant de fermer
ActiveWorkbook.Save

'
Ferme le fichier
ActiveWorkbook
.Close


Je suis pas sur que MAJ_fichiers agissent sur les classeurs que ta macro ouvre mais plutot sur le classeur qui contient le code VBA.

J'espère que d'autres passeront dans le fil te filer un coup de main.

J'essaierai de repasser en fin de soirée ou demain sinon.
 

Staple1600

XLDnaute Barbatruc
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Re


Voici un premier test (je te laisse poursuivre plus loin les investigations)
VB:
Sub Ouvrir_Fichier(Nomdossiers As Scripting.Folders, Nomfichiers As Scripting.Files)
Dim Nomdossier As Scripting.Folder, Nomfichier As Scripting.File
Dim WBK As Workbook
If Nomfichiers Is Nothing Then
Else
    'Pour chaque fichier de la liste de fichiers
    For Each Nomfichier In Nomfichiers
        'Si L'extension du fichier est .xslx ou .xslm ' ici erreur ;-)
        If VBA.Right(Nomfichier, 4) = "xls?" Then
            'Ouvrir le fichier
Set WBK = Workbooks.Open(Filename:=Nomfichier)
MsgBox WBK.Name 'pour test
With WBK.Worksheets(1)
.Unprotect Password:="admin"
MsgBox VBA.Left(.Range("Sujet"), 3) 'pour test
    Select Case VBA.Left(.Range("Sujet"), 3)
    Case "PRE"
        .Range("A2").ClearContents
        .Range("F4") = "7/31/2012"
        .Range("H5") = "PRESTATION JUILLET 2012"
        .Range("M").Copy
        .Range("M_1").PasteSpecial xlPasteValues
        .Range("Del").ClearContents
        Application.CutCopyMode = False
        'je te laisse faire les modifs sur le même modèle
    'Case "TRA"
    'Call prepa_factu_transp
    'Case "CDC"
    'Call prepa_factu_CDC
    Case Else
    MsgBox "Pas de traitement"
    End Select
.Protect Password:="admin"
End With
'Enregistrer avant de fermer
WBK.Save
'Ferme le fichier
WBK.Close
End If
Next
End If
If Nomdossiers Is Nothing Then
Else
        'Pour chaque dossier de la liste de dossiers
        For Each Nomdossier In Nomdossiers
        'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
        'Affecte la liste des fichiers du dossiers en cours
        Set Nomfichiers = Fso.GetFolder(Nomdossier.Path).Files
        'Appel la procédure d'ouverture des fichiers (récursif)
        Call Ouvrir_Fichier(Nomdossier.SubFolders, Nomfichiers)
    'Dossier suivant
    Next Nomdossier
End If
End Sub
 

ChTi160

XLDnaute Barbatruc
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Salut Morgane
Bonjour le Fil
Bonjour le Forum

Je ne suis pas 10lexie , mais j'ai trouvé Lol
Juste pour te Salut JM ,XLS ou XSL ,XLSM ou XSLM etc etc ......
Ensuite
Code:
Right(??????.xlsx,3)  or Right(???????.xlsm,5)  ca renvoie quoi lol ??????
Arfff "That Was the Question" Lol
Bonne journée
Amicalement
Jean Marie
 
Dernière édition:

Morgane

XLDnaute Nouveau
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Salut à vous,

Staple1600, j'ai une bonne et une mauvaise nouvelle; La bonne c'est que le code que tu as fait fonctionne très bien à l'exception d'une petite erreur (c'est la mauvaise nouvelle), lorsque je mets à jour un dossier Type client voici ce que j'obtiens lorsque la macro à déjà tournée sur quelques fichiers :
"Erreur d'éxécution '1004' : Impossible d'ouvrir le fichier ~$Fac presta SIM 2012-04.xlsm car son format ou son extension n'est pas valide. Vérifier que le fichier n'est pas endommagé et que son extension correspond bien au format du fichier."​

J'ai beau chercher, je ne trouve pas ce fichier dans le dossier test que j'ai créer :confused:

Cependant, sur les autres Type client, la macro fonctionne très bien. Vu le nom du fichier indiqué dans le message d'erreur, cela ressemble à un nom de fichier ouvert. Je vais réessayer un peu plus tard pour voir si j'ai toujours la même erreur.

Serait-il possible d'ajouter une gestion d'erreur qui permettrai de passer ce genre de soucis pour passer au fichier suivant ?

En tout cas un grand merci à vous pour vos réponses et votre aide sur ce sujet

PS: pour ton pique nique, rien de tel qu'un bon rosé de loire bien frais de ce temps là.
 

Morgane

XLDnaute Nouveau
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Re,

Un petit mot pour vous dire que j'ai trouver la solution à mon souci ci dessus, il s'agissait bien d'un fichier temporaire qui est resté dans le dossier (en fichier caché bien sûr...) du coup je l'ai supprimé et la routine se déroule très bien jusqu'au bout. :D.

Je vous remercie tous pour votre aide et plus particulièrement Staple1600 qui à été d'une grande aide pour moi.

Dite moi si le code final vous intéresse, je pourrai le mettre dispo si besoin.

Bonne après midi
 

Staple1600

XLDnaute Barbatruc
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Bonsoir à touis


Bien sur qu'il nous intéresse.
Sur un forum, le principe de base, c'est de partager ses connaissances.

Les codes VBA (ou formules) postés n'ont pas vocation à seulement aider l'initiateur du fil.

Tout lecteur qui passe ici est potentiellement intéressé par ce qui s'y trouve.

PS: C'est ta procédure originale qui fonctionne ou une modifiée avec ce que j'ai pu écrire ici ?
 

Morgane

XLDnaute Nouveau
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Re Staple1600,

Ok désolé pour ce délit de non initié ;), voici le code qui fonctionne donc pour ouvrir chaque fichiers avec la notion de dossier et sous dossier.

PHP:
Option Explicit

Dim Fso As Scripting.FileSystemObject
Dim Nomdossiers As Scripting.Folders
Dim Nomfichiers As Scripting.Files
Dim ApplSelectionDossier As FileDialog

Sub Choisir_Fichier()

'Création de la boite de dialogue
Set ApplSelectionDossier = Application.FileDialog(msoFileDialogFolderPicker)

'Choix du dossier
With ApplSelectionDossier

    'Titre de la boite de dialogue
    .Title = "Selectionnez un dossier"

    'L'utilisateur à cliqué sur le bouton OK de la boite de dialogue
    If .Show = -1 Then

        'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
        
        'Affecte la liste des sous dossiers du dossier sélectionné
        Set Nomdossiers = Fso.GetFolder(.SelectedItems(1)).SubFolders
        
        'Affecte la liste des fichiers du dossier en-cours
        Set Nomfichiers = Fso.GetFolder(.SelectedItems(1)).Files
        
        'Appel de la procédure d'ouverture des fichiers
        Call Ouvrir_Fichier(Nomdossiers, Nomfichiers)
        
    'L'utilisateur à cliqué sur le bouton annuler
    Else
    
    End If
    
End With

End Sub

Sub Ouvrir_Fichier(Nomdossiers As Scripting.Folders, Nomfichiers As Scripting.Files)
Dim Nomdossier As Scripting.Folder, Nomfichier As Scripting.File
 Dim WBK As Workbook
 Dim D As Date
 If Nomfichiers Is Nothing Then
 Else
     'Pour chaque fichier de la liste de fichiers
    For Each Nomfichier In Nomfichiers
         'Si L'extension du fichier est .xlsm
        If VBA.Right(Nomfichier, 4) = "xlsm" Then
             'Ouvrir le fichier
 Set WBK = Workbooks.Open(Filename:=Nomfichier)
 With WBK.Worksheets(1)
 'Déverrouiller le fichier
 .Unprotect Password:="admin"
    'Variable de traitement
    Select Case VBA.Left(.Range("Sujet"), 3)
     'Dans le cas ou les 3 première lettre du sujet sont PRE alors
     Case "PRE"
         .Range("A2").ClearContents
         .Range("F4") = "7/31/2012"
         .Range("H5") = "PRESTATION JUILLET 2012"
         .Range("M").Copy
         .Range("M_1").PasteSpecial xlPasteValues
         .Range("Del").ClearContents
         Application.CutCopyMode = False
    'Dans le cas ou les 3 première lettre du sujet sont TRA alors
    Case "TRA"
         .Range("A2").ClearContents
         .Range("F4") = "7/31/2012"
         .Range("H5") = "TRANSPORT JUILLET 2012"
         .Range("M").Copy
         .Range("M_1").PasteSpecial xlPasteValues
         .Range("Del").ClearContents
         Application.CutCopyMode = False
    'Dans le cas ou les 3 première lettre du sujet sont CDC alors
    Case "CDC"
         .Range("A2").ClearContents
         .Range("F4") = "7/31/2012"
         .Range("H5") = "CDC JUILLET 2012"
         .Range("M").Copy
         .Range("M_1").PasteSpecial xlPasteValues
         .Range("Del").ClearContents
         Application.CutCopyMode = False
    'Sinon
    Case Else
     MsgBox "Pas de traitement"
     End Select
 'Protection de la feuille
 .Protect Password:="admin"
 End With
 'Enregistrer avant de fermer
 WBK.Save
 'Ferme le fichier
 WBK.Close
 End If
 Next
 End If
 If Nomdossiers Is Nothing Then
 Else
         'Pour chaque dossier de la liste de dossiers
        For Each Nomdossier In Nomdossiers
         'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
         'Affecte la liste des fichiers du dossiers en cours
        Set Nomfichiers = Fso.GetFolder(Nomdossier.Path).Files
         'Appel la procédure d'ouverture des fichiers (récursif)
        Call Ouvrir_Fichier(Nomdossier.SubFolders, Nomfichiers)
     'Dossier suivant
    Next Nomdossier
 End If
 End Sub

Sinon pour ta question, c'est bien le code que tu as écrit qui fonctionne et non l'original posté au début du fil.

En tout cas encore un grand merci pour votre aide et au plaisir un jour de vous aider (peut-être si mes connaissance me le permette) !

Bonne soirée
 

Discussions similaires

Statistiques des forums

Discussions
311 732
Messages
2 081 995
Membres
101 857
dernier inscrit
mt60400