Discussion :

[Ju.Linou]

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 :

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
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

[DeathZarakai]

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.

[mouftie]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Ju.Linou]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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"

[AlainTech]

Bonjour,

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

[med_mugen]

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 :

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
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

[Ju.Linou]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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?