ouvrir tous les classeur d'un dossier et executer une macro pour chacun

laurent999 · 15 Novembre 2008

Bonsoir à tous,
J'aimerai savoir si il est possible a partir d'un classeur A
1.D'ouvrir successivement tous les classeurs d'un même dossier
2.pour chaqu'un de ces classeurs ouvert aller sur la feuille "suivi de productivité" copier les lignes de 1 à la dernière ligne comprenant des informations.
3.coller ces lignes sur la feuille1 du classeur A à la suite

Ex: Dossier(classeur B,C,D) chacun de ces classeurs ont une feuille nommé "suivi de productivité"
Classeur B."suivi de productivité".ligne 1 "ght"
Classeur C."suivi de productivité".ligne 1 "Gyh"
Classeur D."suivi de productivité".ligne 1 "Tzu"
Résultat
classeur A feuille 1
ligne 1"ght"
ligne 2"Gyh"
ligne 3"Tzu"

Merci d'ance pour vos réponses
Laurent.

kjin · 16 Novembre 2008

Re : ouvrir tous les classeur d'un dossier et executer une macro pour chacun

Bonsoir,
Une méthode parmi d'autres mais simple
Change le chemin du répertoire sans oublier le dernier "\"

Code:

Sub ImportFichS()
    Dim Repertoire As String, FichS As String, FichD As String
    Repertoire = "[COLOR="Blue"]C:\Doc..............\ton dossier\[/COLOR]" [COLOR="SeaGreen"]'mets ici le chemin vers ton dossier[/COLOR]
    FichD = ActiveWorkbook.Name
    FichS = Dir(Repertoire & "*.xls")
    Do While FichS <> ""
        Derlign = ActiveSheet.Range("A65000").End(xlUp).Row + 1
        Workbooks.Open FichS
        Sheets("suivi de productivité").Range("A1:A" & Range("A65000").End(xlUp).Row).Copy
        Windows(FichD).Activate
        Range("A" & Derlign).PasteSpecial Paste:=xlAll
        Application.CutCopyMode = False
        Workbooks(FichS).Close
        FichS = Dir
    Loop
End Sub

Attention l'import se fait sur tous les fichiers .xls de ton répertoire !
A+
kjin

laurent999 · 16 Novembre 2008

Re : ouvrir tous les classeur d'un dossier et executer une macro pour chacun

Bonsoir kjin,

encore merci

J'ai bien changé le chemin comme tu l"as inscrit.
il trouve bien le premier fichier,cependant cela bug
sur Workbooks.Open FichS
il me dit le fichier citroen.xls est introuvable ou a été déplacé.
je comprends pas, il le trouve et me ditintrouvable?
Si tu as une idée.
Merci

ROGER2327 · 16 Novembre 2008

Re : ouvrir tous les classeur d'un dossier et executer une macro pour chacun

Bonsoir à tous

Un coup d'oeil ici

https://www.excel-downloads.com/threads/sommer-tous-les-classeurs-dun-repertoire-specifique.107300/

peut vous être utile.

Bonne nuit,
ROGER2327

ouvrir tous les classeur d'un dossier et executer une macro pour chacun

laurent999

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

laurent999

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

Discussions similaires

ouvrir tous les classeur d'un dossier et executer une macro pour chacun

laurent999

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

laurent999

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency