Appliquer une macro à plusieurs fichiers d'un même répertoir

Le 27/03/2016 à 15:24

Bonjour à tous,

Je travaille actuellement sur une macro excel qui permettrait de traiter plusieurs fichiers xls qui sont dans un même fichier.

Pour le moment, je l'avais fait pour un fichier donné, mais j'aimerais appliquer à tous les fichiers xls de mon répertoire.

Pour un fichier voilà comment ça se présenter :

1- ouverture du fichier xls du répertoire

2- Copie de la colonne qui intéresse

3- coller dans la page de la macro

4- tracer dans une nouvelle feuille de calcul

J'aimerais par exemple l'appliquer à trois fichier, c'est à dire que la macro me traite les fichier un à un et mes les traces les uns après les autres dans de nouvelles feuilles de calcul. Je ne trouve pas la boucle qui le permet.

Merci du coup de main

Back

PS : Je vous mets le code que j'ai fait :

134200mm-49pts-ee6.xlsm (20.90 Ko)
Le 27/03/2016 à 17:09

Hello,

Voilà un début de code qui balaye tous les classeurs d'un répertoire dont l'extension contient "xls", les ouvre puis les ferme. Il faudra éditer le répertoire, et exécuter tes autres procédures entre l'ouverture et la fermeture

Sub test()

Dim repertoire As String
Dim wbook As Workbook
repertoire = "C:\Users\TOTO\Downloads\"

unFichier = Dir(repertoire & "*.xls")
While unFichier <> ""
    Set wbook = Workbooks.Open(repertoire & unFichier, , True)
    'code a réaliser ici
    wbook.Close False
    unFichier = Dir
Wend
End Sub
Le 27/03/2016 à 20:15

Salut d3d9x,

Il me semble que j'ai déjà la boucle while dans mon code qui me permet d'ouvrir tous mes fichiers xls qui sont dans mon répertoire.

De plus, dans ton code, je ne vois pas la boucle qui permet de dire à la macro de copier-coller les datas et tracer le graph pour chaque fichier présent dans mon dossier. tu vois ce que je veux dire ?

++

Back

Le 30/03/2016 à 12:59

Hello,

Quelqu'un aurait une idée ?

Problème non résolu

Le 30/03/2016 à 14:27

Hello backjojo,

Oui mon post ne répondait qu'à ta première problématique. Pour les autres tu as déjà plein de code, il ne fonctionne pas?

Je veux bien t'aider pour là où tu bloques, mais je ne sais pas précisément ce que tu veux faire.

Là on a :

1- ouverture du fichier xls du répertoire OK

2- Copie de la colonne qui intéresse ???

3- coller dans la page de la macro ???

4- tracer dans une nouvelle feuille de calcul ???

#1

Sub test()
 Dim repertoire As String
Dim wbook As Workbook
repertoire = "C:\Users\TOTO\Downloads\"

unFichier = Dir(repertoire & "*.xls")
While unFichier <> ""
    Set wbook = Workbooks.Open(repertoire & unFichier, , True)
    'code a réaliser ici
   wbook.Close False
    unFichier = Dir
Wend
End Sub

#2 + 3 - Copie des colonnes A + B + C ET création d'une nouvelle page ET insertion des valeurs

(En incorporant à la procédure précédente)

Dim nbLignes as Long
Dim maPlage As Range

nbLignes = wbook.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Set maPlage = wbook.Sheets(1).Range("A1:C" & nbLignes)
Dim maFeuille as Worksheet
Set maFeuille  = ThisWorkbook.Sheets.Add 
maFeuille .Range("A1").Resize(maPlage.Rows.Count, maPlage.Columns.Count).Value = maPlage.Value

#4 - Je pense que tu as déjà

Le 30/03/2016 à 15:18

Hello,

le seul problème est pour que ça le fasse pour chaque fichier.

c'est à dire, si j'ai trois fichiers différents, je devrais avoir 3 graphes.

tu vois ?

Le 30/03/2016 à 15:47

Non justement je vois pas ^^

Là en combinant les deux codes, tu as pour chaque fichier xls une page créée dans ton fichier de calcul.

Tu as plus qu'à ajouter sur chaque feuille créée un nouveau graphe, où est le problème??

En reprenant le code précédent, tu ajoutes:

'Code précédent
Set maFeuille = ThisWorkbook.Sheets.Add
maFeuille .Range("A1").Resize(maPlage.Rows.Count, maPlage.Columns.Count).Value = maPlage.Value
'Code précédent
Dim monGraphe As Chart
Set monGraphe = maFeuille.Shapes.AddChart(xlXYScatter).Chart
With monGraphe
    .SeriesCollection.NewSeries
    .SeriesCollection(1).XValues = "=" & maFeuille.Name & "!$A$1:$A$1"
    .SeriesCollection(1).Values = "=" & maFeuille.Name & "!$B$1:$B$1"
End With
Le 30/03/2016 à 16:10

Ok je vais essayer ca alors

Merci

Le 25/07/2016 à 17:19

Bonjour !

J'ai problème assez similaire, je voudrais appliquer une macro sur plusieurs fichiers d'un même répertoire.

Pour faire une rapide explication, ma macro est la suivante : tous mes fichiers ont exactement les mêmes feuilles nommées de la même façon et je veux afficher la moyenne toute les 4 ou 5 valeurs sur la colonne de droite. Mon code fonctionne bien sur le premier fichier, et je voudrais essayer l'appliquer à tous les autres. Nommons le fichier qui contient la macro fichier1.xls et les autres fichieri.xls pour que ce soit plus simple

Mon code est le suivant

Dim j As Integer, nbreBin As Integer, binActuel As Integer, i As Long
    binActuel = 0
    i = 3

    Dim puidMin As Integer, puidMax As Integer, nbrePuid As Integer
    puidMin = WorksheetFunction.Min(Range("B4:B11"))
    puidMax = WorksheetFunction.Max(Range("B4:B11"))
    nbrePuid = puidMax - puidMin + 1

    While binActuel < 360
    Sheets(CStr(binActuel)).Select
        While Cells(i, 2) <> 0
            Cells(i, 8) = WorksheetFunction.Average(Range(Cells(i, 3), Cells(i + nbrePuid - 1, 3)))
            i = i + nbrePuid

        Wend
        binActuel = binActuel + 20
        i = 3
wend

donc j'essaie d'ajouter ta partie de maccro comme ca :

Public Sub compMoyenne()

Dim repertoire As String

Dim wbook As Workbook

repertoire = "C:\Users\stagiaire2\Documents\puissance fonction direction\20-07\résultats analyse\2014\5-7"

unFichier = Dir(repertoire & "*.xls")

While unFichier <> ""

Set wbook = Workbooks.Open(repertoire & unFichier, , True)

Dim j As Integer, nbreBin As Integer, binActuel As Integer, i As Long

binActuel = 0

i = 3

Dim puidMin As Integer, puidMax As Integer, nbrePuid As Integer

puidMin = WorksheetFunction.Min(Range("B4:B11"))

puidMax = WorksheetFunction.Max(Range("B4:B11"))

nbrePuid = puidMax - puidMin + 1

While binActuel < 360

Sheets(CStr(binActuel)).Select

While Cells(i, 2) <> 0

Cells(i, 8) = WorksheetFunction.Average(Range(Cells(i, 3), Cells(i + nbrePuid - 1, 3)))

i = i + nbrePuid

Wend

binActuel = binActuel + 20

i = 3

Wend

wbook.Close False

unFichier = Dir

Wend

End Sub

mais là, quand je debogue étape par étape il ne rentre même plus dans le while qui ouvre les fichiers. Que faire ?

Merci d'avance maitres codeurs !

pioupiou

Le 25/07/2016 à 19:04

Bonjour pioupiou53,

Probablement une erreur à la ligne suivante (oublie d'un "\")

repertoire = "C:\Users\stagiaire2\Documents\puissance fonction direction\20-07\résultats analyse\2014\5-7\"
Le 26/07/2016 à 10:12

Ca fonctionne parfaitement ! il fallait aussi que je pense à sauvegarder après chaque ouverture et que je précise que l'onglet que je sélectionne est dans la worksheet que je viens d'activer et ça fonctionne comme si des roulettes !

Tu peux me dire comment on peut modifier un tantinet le code pour pas avoir besoin d'accepter que VB renomme le fichier ?

Merci encore !

Pioupiou

Le 26/07/2016 à 20:28

Bonjour Pioupiou,

Je ne comprend pas ta question:

Tu peux me dire comment on peut modifier un tantinet le code pour pas avoir besoin d'accepter que VB renomme le fichier ?

Peux-tu utiliser les balises "surligner" pour mettre en avant le contenu que tu souhaites optimiser dans le code?
Rechercher des sujets similaires à "appliquer macro fichiers meme repertoir"