Snthese de plusieurs classeurs - Erreur d'éxécution 1004

Question

Bonjour à tous et merci d'avance pour votre aide,

je débute en VBA et je cherchais à faire une synthèse de plusieurs classeurs figurant dans un seul dossier automatiquement.

Mes fichiers sources faisant tous les même dimensions, j'ai réussi à faire une macro qui marche parfaitement avec le code suivant :

Sub Test()

Application.ScreenUpdating = False

    Dim LigneDebut As Long, LigneFin As Long
    LigneDebut = 4
    LigneFin = 20

    ChDir "D:\Mes Documents\03-Tableaux de bord\Base de données\RH\Absenteisme_Par_Mois"
    AbsenteismeMois = Dir("D:\Mes Documents\03-Tableaux de bord\Base de données\RH\Absenteisme_Par_Mois\") 'NomFichier = premier fichier trouvé dans le dossier du lien (2009_01_indicateurs.xlsx)

        While Len(AbsenteismeMois) > 0   'La Longueur de 2009_01_indicateurs.xlsx est de 24 caracteres donc >0
                Workbooks.Open AbsenteismeMois
                    Workbooks("Classeur1.xlsm").ActiveSheet.Range("E" & LigneDebut, "AJ" & LigneFin).Value = Workbooks(AbsenteismeMois).ActiveSheet.Range("B8:AG24").Value
                Workbooks(AbsenteismeMois).Close
                AbsenteismeMois = Dir 'On lit le fichier suivant du dossier (2009_02_indicateurs.xlsx)
                LigneDebut = LigneDebut + 17
                LigneFin = LigneFin + 17

        Wend ' Comme la longueur de 2009_02_indicateurs.xlsx est >0, on recommence et ainsi de suite sur tous les fichiers du dossier.

End Sub

Quelques infos pour aider la compréhension :

Nom du dossier en question :

Absenteisme_Par_Mois

Fichiers du dossier : (72 au total)

2009_01_indicateurs.xlsx

2009_02_indicateurs.xlsx

2009_03_indicateurs.xlsx

2014_12_indicateurs.xlsx

Fichier de synthese :

Classeur1.xlsm

Sauf que voilà, la macro ne s’exécute que lorsque le premier fichier du dossier (2009_01_indicateurs.xlsx) est ouvert ou a été ouvert.

Exemple :

- J'ouvre "Classeur1", je lance la Macro et là j'ai un message d'erreur qui apparait me disant :

Erreur d'éxécution '1004':
'2009_01_indicateurs.xlsx' introuvable. Vérifiez l'orthographe du nom du classeur et la validité de l'emplacement.
Si vous essayez d'ouvrir le fichier à partir de la liste des fichiers les plus récents, assurez-vous que le fichier n'a pas été renommé, déplacé ou supprimé.

Je clique sur "Débogage" et il me surligne en jaune la ligne "Workbooks.Open AbsenteismeMois"

- J'ouvre 2009_01_indicateurs.xlsx et Classeur1, je lance la macro, elle marche normalement.

- je ferme 2009_01_indicateurs.xlsx, j'efface les données de Classeur1, je relance la Macro elle marche à nouveau.

- j'enregistre Classeur1, je le ferme, je l'ouvre à nouveau, je lance la macro et là.. retour au message d'erreur précédent.

je ne sais pas du tout quoi faire.

D'avance merci pour vos réponses.

ThauThème · Answer

A tester, la macro ci-dessous à mettre dans le fichier destination : Classeur1.xlsm : Sub Test() Dim CD As Workbook 'déclare la variable CD (Classeur Destination) Dim OD As Worksheet 'déclare la variable OD (Onglet Destination) Dim CS As Workbook 'déclare la variable CS (Classeur Source) Dim OS As Worksheet 'déclare la variable OD (Onglet Source) Dim SF As Object 'déclare la variable SF (Système de Fichiers) Dim D As Object 'déclare la variable D (Dossier) Dim EF As Object 'déclare la variable EF (Ensemble de Fichiers) Dim F As Object 'déclare la variable F (Fichier) Dim LD As Long 'déclare la variable LD (Ligne de Début) Dim LF As Long 'déclare la variable LF (Ligne de Fin) Application.ScreenUpdating = False 'masque les rafraîchissements d'écran Set CD = ThisWorkbook 'définit le classeur CD Set OD = CD.Sheets(1) 'définit l'onglet OD (à adapter) Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF Set D = SF.GetfFolder("D:\Mes Documents\03-Tableaux de bord\Base de données\RH\Absenteisme_Par_Mois") 'définit le dossier D Set EF = D.Files 'définit l'ensembles des fichiers du dossier D LD = 4 'initialise la ligne de début LD LF = 20 'initialise la ligne de fin LF For Each F In EF 'boucle sur tous les fichiers F de l'ensemble des fichier EF 'condition : si les 17 derniers caractères du nom du fichier sont "_indicateurs.xlsx" If Right(F.Name, 17) = "_indicateurs.xlsx" Then Workbooks.Open (F) 'ouvre le fichier F Set CS = ActiveWorkbook 'définit le classeur source CS Set OS = CS.Sheets(1) 'définit l'onglet source OS (à adapter) 'récupère les données de l'onglet source OS dans l'onglet destination OD OD.Range(OD.Cells(LD, 5).OD.Cells(LF, 36)).Value = OS.Range("B8:AG24").Value CS.Close False 'ferme le classeur source sans enregistrer LD = LD + 17 'incrémente la ligne de début LD LF = LF + 17 'incrémente la ligne de fin LF End If 'fin de la condition Next F 'prochain fichier de la boucle Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran End Sub...