récupération deuil sur un mois

[B]récupération deuil sur un mois[/B]

Sub Import()
Dim dossierAnalyse As Object, sousDossierAnalyse As Object, fichierAnalyse As Object
Dim pathDossierAnalyse As String, nomFichier As String, nomOnglet As String, moisAnalyse As String, anneeAnalyse As String
Dim tabStr() As String, wbk As Workbook, sht As Worksheet

'****** Définir les variables de la macro ******
pathDossierAnalyse = "E:\aMiki\XLS\test\DossierTest"
nomFichier = "toto.xls"
nomOnglet = "test"
moisAnalyse = "10"
anneeAnalyse = "09"
'***********************************************

'récupérer le dossier analysé
Set dossierAnalyse = CreateObject("Scripting.FileSystemObject").GetFolder(pathDossierAnalyse)

'boucler sur tous ses sous-dossier
For Each sousDossierAnalyse In dossierAnalyse.SubFolders
    
    'récupérer la date (nom du sous-dossier) dans un tableau
    tabStr = Split(sousDossierAnalyse.Name, "_")
    
    'si le sous dossier fait partie du mois et de l'année analysés
    If tabStr(1) = moisAnalyse And tabStr(2) = anneeAnalyse Then
        
        'boucler sur tous les fichiers du sous-dossier
        For Each fichierAnalyse In sousDossierAnalyse.Files
            
            'si le fichier porte les bon nom
            If fichierAnalyse.Name = nomFichier Then
                
                'ouvrir le fichier en lecture seule
                Set wbk = Application.Workbooks.Open(fichierAnalyse.Path, , True)
                
                'boucler sur tous les onglets du fichier
                For Each sht In wbk.Sheets
                    
                    'si l'onglet courant porte le bon nom
                    If sht.Name = nomOnglet Then
                        
                        With ThisWorkbook
                        
                            'copier l'onglet à la suite des onglets de ce classeur
                            sht.Copy after:=.Sheets(.Sheets.Count)
                            
                            'renommer le nouvel onglet de ce classeur avec le numéro du jour
                            .Sheets(.Sheets.Count).Name = tabStr(0)
                            
                        End With
                    End If
                Next sht
                
                'fermer le classeur (sans enregistrer les changements
                wbk.Close False
            End If
        Next fichierAnalyse
    End If
Next sousDossierAnalyse

'détruire les objets
Set dossierAnalyse = Nothing
End Sub