Compiler plusieurs fichiers en un seul: création base de données

Bonjour,

Je possède un dossier ("mon_dossier") qui contient "n" fichiers Excel (fiche1.xlsm, fiche2.xlsm,...) alliant tous la même architecture : 4 onglets différents dont le dernier "Compil" reprend les informations des précédents.
Je souhaite récupérer, dans la feuille "ma_feuille," les lignes non-vides des colonnes B à AX de l'onglet "Compil" de tous ces fichiers.
Ces lignes ainsi récupérées devront s'incrémenter les unes à la suite des autres afin de ne constituer qu'un seul fichier.
Pour cela j'ai créé une macro VBA dans le fichier "ma_feuille" qui récupère les informations de l'onglet "Compil" des fichiers "fiche*.xlsm" et les incrémente les unes après les autres.
L'utilisateur devra appuyer sur un bouton de commande pour lancer la macro. Ce bouton de commande est dans le fichier "ma_feuille" dans l'onglet "Execution" tandis que les informations récupérés des autre fichiers sont dans l'onglet "Base".

Voici mon code :

Code:

---

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

Sub Transfert() Application.DisplayAlerts = False 'Evite les messages d'Excel Application.EnableEvents = False 'Evite l'exécution éventuelle de macros liées aux fichiers ouverts   ChDir ThisWorkbook.Path ' Répertoire application nb = ActiveSheet.UsedRange.Rows.Count 'Compte le nombre de ligne de la feuille Range("B" & nb + 1).Select nf = Dir("fiche*.xlsm") ' Première fiche MsgBox "Vous êtes en train de compiler le fichier " & nf Do While nf <> "" Workbooks.Open Filename:=nf Sheets("Compil").Activate nb_ligne = ActiveSheet.UsedRange.Rows.Count - 8 'Compte le nombre de ligne du fichier Compil Range("B9:AX" & nb_ligne).Copy ' Copie les données de la feuille Compil Windows("ma_feuille.xlsm").Activate Sheets("Base").Activate   'Colle la mise en forme Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False 'Colle les valeurs Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows(nf).Activate ActiveWorkbook.Close savechanges:=False   ' Recopie le nom du fichier dans la première colonne ActiveCell.Offset(0, -1) = nf ActiveCell.Offset(nb_ligne + 1, 0).Select nf = Dir() ' Fiche suivante Loop   'Supprime l'extension du nom de fichier Columns("A:A").Replace ".xlsm", "" 'Ajustement des colonnes Cells.EntireColumn.AutoFit   'Supprime les lignes vides For Lin = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1 If Rows(Lin).Find("*") Is Nothing Then Rows(Lin).Delete Next Lin   MsgBox "Compilation terminée" Sheets("Execution").Activate Application.EnableEvents = True Application.DisplayAlerts = True   End Sub

---

Mon code est fonctionnel dans un certains cas: lorsque j'enregistre un fichier "fiche*.xlsm" lorsque le fichier "ma_feuille" est ouvert. Ainsi la macro se lance bien. Le problème que je rencontre est que si jamais j'ai enregistré le fichier "fiche*.xlsm" la veille ou que je n'ai pas enregistré ce fichier "fiche*.xlsm" lorsque le ficher "ma_feuille" est ouvert alors ma macro ne veut pas se lancer.

Je ne sais pas d'où vient ce problème, ni comment le résoudre. Avez-vous une idée?

Je vous remercie par avance de votre aide

Julie

Alors je pense avoir cerné ton problème mais ma solution est loin d'être certaine.
Je pense que dans ton Dir tu devrais mettre l'adresse avant Dir("C://Mon_Dossier/fiche*.xlsm").
Je suis vraiment pas sûr que se soit la solution. A la limite si le fichier doit voyager utilise un ThisWorkbook.Path au préalable.

En espérant que sa corrige ton problème, sinon je vois pas.

DeathZarakai.

Bonjour Julie
Tu ne vérifies pas si fiche*.xlsm est ouvert
Essaies-ça

Code:

---

1 2	nf = Dir("fiche*.xlsm") If nf = "" then msgbox "ouvrir ou enregistrer Fiche"

---

Citation:

---

Envoyé par DeathZarakai

Je pense que dans ton Dir tu devrais mettre l'adresse avant Dir("C://Mon_Dossier/fiche*.xlsm").
DeathZarakai.

---

J'ai essayé ta solution. Le fichier est bien détecté, le Msgbox m'affiche bien "Vous êtes en train de compiler le fichier fiche1.xlsm".

Code:

---

1 2 3

nf=Dir("P:\Mon_dossier\fiche*.xlsm") MsgBox "Vous êtes en train de compiler le fichier " & nf

---

Cependant lorsque j'arrive à :

Code:

---

1 2	Workbooks.Open Filename:=nf

---

J'ai l'erreur suivante: Erreur d'exécution '1004'
'fiche1.xlsm' introuvable. Vérifier l'orthographe du nom du classeur et la validité de l'emplacement. Si vous essayer 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é.

Erreur que je n'avais pas avant. Ce qui m'étonne c'est que la macro arrive tout d'abors à détecter le fichier étant donné que le MsgBox me donne son nom mais au moment de l'ouvrir il ne le vois plus. Savez vous pourquoi?

Citation:

---

Envoyé par mouftie

Bonjour Julie
Tu ne vérifies pas si fiche*.xlsm est ouvert
Essaies-ça

Code:

---

1 2	nf = Dir("fiche*.xlsm") If nf = "" then msgbox "ouvrir ou enregistrer Fiche"

---

---

Je ne souhaite pas vérifier si les fichiers sont ouverts, je ne veux pas y toucher une fois qu'ils sont enregistré. Je souhaite pouvoir lancer ma macro du fichier "ma_feuille" sans toucher aux fichiers de données "fiche*.xlsm"

Bonjour,

C'est dans le Workbooks.Open qu'il faut le chemin (terminé par un \) et le nom du fichier

Salut Ju.Linou,

J'ai déjà eu affaire à ce type de problématique (extraire des données et les compiler dans un fichier unique). Je ne sais pas si ca répond à ton probleme. A l'époque mes fichiers à compiler avaient tous le même format et figurait dans un même dossier. Les données à extraire figuraient dans une même feuille (comme ta feuille 'compile') et avaient la même configuration. C'était les lignes du tableau qui se trouvaient dans cette feuille que je devais compiler de la même manière que toi.

Cette macro fonctionne parfaitement. Elle ouvre les fichiers à extraire et les referme une fois les données extraites et compilées.

Code:

---

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

Sub extraction()   Dim Fichier As String Dim Chemin As String Dim ClasseurSource As Workbook     Application.DisplayAlerts = False 'Evite les messages d'Excel Application.EnableEvents = False 'Evite l'exécution éventuelle de macros liées aux fichiers ouverts       Chemin = "C:\mon_dossier\" 'Chemin du répertoire contenant les fichiers Fichier = Dir(Chemin & "*.xls*") '* correspond à tous les types de fichiers excel contenus dans ton dossier (évite donc de mettre à coté des fichiers "fiche" à extraire ton fichier "ma_feuille"   ThisWorkbook.Worksheets("Base").Range("A6:BT10000").ClearContents ' efface la plage existante dans ton classeur de consolidation     Do While Fichier <> "" Set ClasseurSource = Workbooks.Open(Chemin & Fichier)   ClasseurSource.Worksheets("compil").Range("Tableau5").Copy ' à l'époque je devais copier les lignes d'un tableau. adapte alors la formule selon tes souhaits (notamment élimination des lignes non vide)     ThisWorkbook.Worksheets("Base").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 'idem adapte ta formule si tu souhaites conserver ton format de cellules     ClasseurSource.Close Fichier = Dir Loop   Application.EnableEvents = True Application.DisplayAlerts = True       End Sub

---

J'espère que ceci répond à ta problématique.

Bien à toi

med_mugen

Je procède personnellement comme med_mugen

Code:

---

1 2 3

Set Wb1 = Workbooks.Open(Chemin1, 0) 'le chemin est ce que tu renseigne dans ton Dir, c'est un String c'est adresse & nomfichier 'le 0 c'est pour dire non mise a jour lien actifs

---

Avec cette méthode j'arrive à ouvrir des fichiers déjà ouvert.
De plus et très important à mon avis, cette méthode permet de travaillé en différencient bien les classeurs

Code:

---

Wb1.WorkSheets(1).Range("A1") 'cette ligne touchera le fichier ouvert

---

Mais ce que je raconte est clairement pour éclaircir ce que med t'a donné car je procède comme lui à la seule diff que je n'utilise pas Dir pour renseigner le fichier car moi je dois renseigner le nom exact à cause de certains soucis.


DeathZarakai