Synthèse fichier excel dans divers repertoires

Bonjour,

Essaie ceci :

Ceci traite tous les fichiers de tous les sous-répertoires (1er niveau)
d'un répertoire principal.

Pour cette section, le traitement de chaque fichier, tu disais avoir déjà le
code
' Workbooks.Open (monfichier)
' Set Wk = ActiveWorkbook
'reste du code
' Wk.Close

En conséquence, tu devras adapter!

'--------------------------------------------
Sub test()
Dim Fs As Object, F As Object, Répertoire As String
Dim Fichier As Object, MonFichier As String

'Répertoire de départ à définir...
Répertoire = "C:UsersTon profilDocuments"

Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(Répertoire)


For Each Fichier In F.SubFolders
MonFichier = Dir(Fichier & "" & "*.xl*")
Do While MonFichier <> ""
' Workbooks.Open (monfichier)
' Set Wk = ActiveWorkbook
'reste du code
' Wk.Close
MonFichier = Dir()
Loop
Next
End Sub
'--------------------------------------------

Le mardi 28 Janvier 2014 à 11:58 par Modjow :

Bonjour,

Voici mon problème :

Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).

Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)

J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.

Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.

Merci d'avance pour l'attention que vous accorderez à mon petit
problème!

Tout d'abord merci pris le temps de me repondre.

En effet j'ai un code (assez compliqué pour moi) que j'ai récupéré sur internet et que j'ai adapté un peu pour recupèrer mes infos.
C'est un code permet normalement de selectionner plusieurs fichier Excel en meme temps pour en faire une synthèse, cependant mes fichier se trouvent dans des repertoires differents. Le code ne prend pas en compte les sous repertoires, donc ne fonctionne pas totalement.

Sub Creer_Recapitulatif()
Dim wbRecap As Workbook 'fichier recap
Dim wsRecap As Worksheet 'feuille où on écrit les données
Dim Wbsource As Workbook 'fichier à ouvrir
Dim wsSource As Worksheet 'feuille où on cherche les données
Dim Rep As Variant 'répertoire à traiter
Dim DernLign As Integer 'ligne où on écrit les données
Dim vFichiers As Variant 'noms des fichiers
Dim I As Integer, K As Integer, A As Integer
Dim B As Long, C As Long, D As Long, E As Long, F As Long, G As Long, H As Long, J As Long, M As Long, V As Long, L As Long, N As Long, P As Long, S As Long, Q As Long, R As Long, U As Long

Dim rgRecap As Range 'plage où on copie les données
Dim vboucle As Action

Set wbRecap = ThisWorkbook 'Fichier récapitulatif
Set wsRecap = wbRecap.Sheets(1) 'on écrit dans la feuille 1 du fichier récapitulatif

' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir

vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers

' --- Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
Debug.Print "Aucun fichier sélectionné."
MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next

Application.ScreenUpdating = False

' --- Boucle à travers les fichiers
For K = 1 To UBound(vFichiers)
Application.StatusBar = ">> Lecture du fichier #" & K & "/" & UBound(vFichiers)

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' C'est ici qu'on écrit les instructions

Set Wbsource = Workbooks.Open(vFichiers(K), ReadOnly = False) 'on ouvre le fichier
Set wsSource = Wbsource.Sheets(1) 'On copie les données de la feuille 1
DernLign = wbRecap.Sheets(1).Range("A60000").End(xlUp).Row + 3 'ligne pour écrire le log des fichiers compilés

' - On copie les données vers le fichier Recapitulatif; à adapter

Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)

With wsSource

'Mon code pour recupèrer les données dans differentes cellules

End With

Wbsource.Close Savechanges:=False 'fermer fichier

Set Wbsource = Nothing
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Sub

Function Selectionner_Fichiers(Stitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean


sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=Stitre, MultiSelect:=bMultiSelect)


End Function

Cependant j'ai aucune idée si je peux intégrer directement le code ci-dessus dans le code que tu m'a envoyé.

Etant donné que je suis un débutant en VBA j'ai beuacoup de mal à m'y retrouver.

Le mardi 28 Janvier 2014 à 11:58 par Modjow :

Bonjour,

Voici mon problème :

Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).

Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)

J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.

Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.

Merci d'avance pour l'attention que vous accorderez à mon petit
problème!

Tout d'abord merci pris le temps de me repondre.

En effet j'ai un code (assez compliqué pour moi) que j'ai récupéré sur internet et que j'ai adapté un peu pour recupèrer mes infos.
C'est un code permet normalement de selectionner plusieurs fichier Excel en meme temps pour en faire une synthèse, cependant mes fichier se trouvent dans des repertoires differents. Le code ne prend pas en compte les sous repertoires, donc ne fonctionne pas totalement.

Sub Creer_Recapitulatif()
Dim wbRecap As Workbook 'fichier recap
Dim wsRecap As Worksheet 'feuille où on écrit les données
Dim Wbsource As Workbook 'fichier à ouvrir
Dim wsSource As Worksheet 'feuille où on cherche les données
Dim Rep As Variant 'répertoire à traiter
Dim DernLign As Integer 'ligne où on écrit les données
Dim vFichiers As Variant 'noms des fichiers
Dim I As Integer, K As Integer, A As Integer
Dim B As Long, C As Long, D As Long, E As Long, F As Long, G As Long, H As Long, J As Long, M As Long, V As Long, L As Long, N As Long, P As Long, S As Long, Q As Long, R As Long, U As Long

Dim rgRecap As Range 'plage où on copie les données
Dim vboucle As Action

Set wbRecap = ThisWorkbook 'Fichier récapitulatif
Set wsRecap = wbRecap.Sheets(1) 'on écrit dans la feuille 1 du fichier récapitulatif

' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir

vFichiers = Selectionner_Fichiers("e;Sélectionner les fichiers à compiler"e;) 'Appel de Fonction pour ouvrir fichiers

' --- Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
Debug.Print "e;Aucun fichier sélectionné."e;
MsgBox "e;Erreur! Aucun/Mauvais fichier sélectionné."e;
Exit Sub
End If
On Error Resume Next

Application.ScreenUpdating = False

' --- Boucle à travers les fichiers
For K = 1 To UBound(vFichiers)
Application.StatusBar = "e;>> Lecture du fichier #"e; & K & "e;/"e; & UBound(vFichiers)

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' C'est ici qu'on écrit les instructions

Set Wbsource = Workbooks.Open(vFichiers(K), ReadOnly = False) 'on ouvre le fichier
Set wsSource = Wbsource.Sheets(1) 'On copie les données de la feuille 1
DernLign = wbRecap.Sheets(1).Range("e;A60000"e;).End(xlUp).Row + 3 'ligne pour écrire le log des fichiers compilés

' - On copie les données vers le fichier Recapitulatif; à adapter

Set rgRecap = wsRecap.Range("e;A65000"e;).End(xlUp).Offset(1, 0)

With wsSource

'Mon code pour recupèrer les données dans differentes cellules

End With

Wbsource.Close Savechanges:=False 'fermer fichier

Set Wbsource = Nothing
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Sub

Function Selectionner_Fichiers(Stitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean


sFiltre = "e;Fichiers XYZ (.xls)(.xlsm), *.xls*"e;
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=Stitre, MultiSelect:=bMultiSelect)


End Function

Cependant j'ai aucune idée si je peux intégrer directement le code ci-dessus dans le code que vous m'avez envoyé.

Etant donné que je suis un débutant en VBA j'ai beuacoup de mal à m'y retrouver.

Si tu as de la difficulté à écrire la macro pour copier les données,
dis-nous dans quelle feuille se retrouvent les données que tu veux
copier vers le fichier de compilation. Est-ce le nom de cet onglet
est toujours le même pour tous les classeurs?

Quelle est la plage que tu veux copier de ces fichiers vers ton fichier
de compilation?

Comment s'appelle ton fichier de compilation?

Quel est le nom de l'onglet où sont amassées les données dans le
fichier de compilation?

Le mardi 28 Janvier 2014 à 11:58 par Modjow :

Bonjour,

Voici mon problème :

Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).

Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)

J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.

Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.

Merci d'avance pour l'attention que vous accorderez à mon petit
problème!

Mon fichier de compilation s'apelle "Synthèse FT" et l'onglet dans lequel je copie toutes mes données s'appelle "Liste FT".

L'onglet Excel (Onglet "Temps") à partir du quel je veux recupèrer l'information est similaire a tous les fichier Excel.

Voila le code que j'utilise pour copier les plages de données. Il faut savoir que je ne copie pas seulement les plages, mais uniquement les infos que contiennent les plages (je ne prend pas en compte les cellules vides).

Je n'ai pas mis ce code dans mon poste précedent car j'avais peur que cela soit un peu lourd.
L'emplacement de ce code se trouve à la place de 'Mon code pour recupèrer les données dans differentes cellules'


'Mon code pour recupèrer les données dans differentes cellules :

' Infos sur la Fonction Technique

rgRecap.Offset(0, 0) = .Range("A5")
rgRecap.Offset(0, 1) = .Range("C5")

' Infos sur l'avancement

rgRecap.Offset(1, 1) = .Range("I15")

' Infos sur le chrono

rgRecap.Offset(2, 0) = .Range("H16")
rgRecap.Offset(2, 1) = .Range("I16")

' Infos sur le process

rgRecap.Offset(3, 0) = .Range("H17")
rgRecap.Offset(3, 1) = .Range("I17")

' Infos sur l'éval érgonomique

rgRecap.Offset(4, 0) = .Range("H18")
rgRecap.Offset(4, 1) = .Range("I18")

' Infos sur les demandes de régul

rgRecap.Offset(5, 0) = .Range("H19")
rgRecap.Offset(5, 1) = .Range("I19")


' Liste KY
coldebut = 165
colfin = 364
'rgRecap.Offset(0, 3) = .Range("FI22")

For I = coldebut To colfin
rgRecap.Offset(I - 164, 3) = .Range(Cells(24, I), Cells(24, I))
Next I


' Liste Kz
coldebut = 366
colfin = 565
'rgRecap.Offset(0, 4) = .Range("NB22")

For I = coldebut To colfin
rgRecap.Offset(I - 365, 4) = .Range(Cells(24, I), Cells(24, I))
Next I


' Liste SOP
coldebut = 165
colfin = 565
'rgRecap.Offset(0, 5) = .Range("FI2")

For I = coldebut To colfin
rgRecap.Offset(I - 164, 5) = .Range(Cells(4, I), Cells(4, I))
Next I

'Désignation+Liste pièces sécuritaires
ligndebut = 30
lignfin = 1000

'rgRecap.Offset(0, 6) = .Range("UV27")

For I = ligndebut To lignfin

If .Range(Cells(I, 568), Cells(I, 568)) <> "" Then
B = B + 1
rgRecap.Offset(B, 6) = .Range(Cells(I, 568), Cells(I, 568))

End If
Next I

' Désignation+Liste pièces stratégiques
ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 9) = .Range("VE27")

For I = ligndebut To lignfin

If .Range(Cells(I, 577), Cells(I, 577)) <> "" Then
C = C + 1
rgRecap.Offset(C, 7) = .Range(Cells(I, 577), Cells(I, 577))

End If
Next I

'Infos demande conditionnement

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 10) = .Range("VI27")

For I = ligndebut To lignfin

If .Range(Cells(I, 581), Cells(I, 581)) <> "" Then
D = D + 1
rgRecap.Offset(D, 8) = .Range(Cells(I, 581), Cells(I, 581))

End If
Next I


'Demande dde implantation

ligndebut = 30
lignfin = 1000

'rgRecap.Offset(0, 11) = .Range("VK27")

For I = ligndebut To lignfin

If .Range(Cells(I, 583), Cells(I, 583)) <> "" Then
E = E + 1
rgRecap.Offset(E, 9) = .Range(Cells(I, 583), Cells(I, 583))

End If
Next I

'Demande moyen de manut

ligndebut = 30
lignfin = 1000

For I = ligndebut To lignfin

If .Range(Cells(I, 593), Cells(I, 593)) <> "" Then
F = F + 1
rgRecap.Offset(F, 10) = .Range(Cells(I, 593), Cells(I, 593))

End If
Next I

'Dde pontier

ligndebut = 30
lignfin = 1000

For I = ligndebut To lignfin

If .Range(Cells(I, 595), Cells(I, 595)) <> "" Then
G = G + 1
rgRecap.Offset(G, 11) = .Range(Cells(I, 595), Cells(I, 595))

End If
Next I


'Dde manut elec

ligndebut = 30
lignfin = 1000

For I = ligndebut To lignfin

If .Range(Cells(I, 596), Cells(I, 596)) <> "" Then
J = J + 1
rgRecap.Offset(J, 12) = .Range(Cells(I, 596), Cells(I, 596))

End If
Next I
'Demande formation specif+ Liste

ligndebut = 30
lignfin = 1000


For I = ligndebut To lignfin

If .Range(Cells(I, 604), Cells(I, 604)) <> "" Then
V = V + 1
rgRecap.Offset(V, 13) = .Range(Cells(I, 604), Cells(I, 604))

End If
Next I

'Demande+Liste gabarits

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 14) = .Range("WI27")

For I = ligndebut To lignfin

If .Range(Cells(I, 607), Cells(I, 607)) <> "" Then
L = L + 1
rgRecap.Offset(L, 14) = .Range(Cells(I, 607), Cells(I, 607))

End If
Next I

'Demande Outil portatif + Liste

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 15) = .Range("WV27")

For I = ligndebut To lignfin

If .Range(Cells(I, 620), Cells(I, 620)) <> "" Then
M = M + 1
rgRecap.Offset(M, 15) = .Range(Cells(I, 620), Cells(I, 620))

End If
Next I

'FraC conformité + Liste

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 16) = .Range("WV27")

For I = ligndebut To lignfin

If .Range(Cells(I, 637), Cells(I, 637)) <> "" Then
N = N + 1
rgRecap.Offset(N, 16) = .Range(Cells(I, 637), Cells(I, 637))

End If
Next I

'FraC fonctionnel + Liste

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 16) = .Range("WV27")

For I = ligndebut To lignfin

If .Range(Cells(I, 641), Cells(I, 641)) <> "" Then
O = O + 1
rgRecap.Offset(O, 16) = .Range(Cells(I, 641), Cells(I, 641))

End If
Next I

'Evac déchets + Liste

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 16) = .Range("WV27")

For I = ligndebut To lignfin

If .Range(Cells(I, 651), Cells(I, 651)) <> "" Then
P = P + 1
rgRecap.Offset(P, 18) = .Range(Cells(I, 651), Cells(I, 651))

End If
Next I

'Environnement+ Liste

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 16) = .Range("WV27")

For I = ligndebut To lignfin

If .Range(Cells(I, 653), Cells(I, 653)) <> "" Then
Q = Q + 1
rgRecap.Offset(Q, 19) = .Range(Cells(I, 653), Cells(I, 653))

End If
Next I

'Controle+Liste d'outillage

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 20) = .Range("YK27")

For I = ligndebut To lignfin

If .Range(Cells(I, 661), Cells(I, 661)) <> "" Then
R = R + 1
rgRecap.Offset(R, 20) = .Range(Cells(I, 661), Cells(I, 661))

End If
Next I

' OP CODIFIEES

ligndebut = 30
lignfin = 1000

rgRecap.Offset(0, 21) = .Range("E28")

For I = ligndebut To lignfin

If .Range(Cells(I, 5), Cells(I, 5)) <> "" Then
S = S + 1
rgRecap.Offset(S, 21) = .Range(Cells(I, 5), Cells(I, 5))

End If
Next I


' POKA YOKE

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 21) = .Range("E28")

For I = ligndebut To lignfin

If .Range(Cells(I, 624), Cells(I, 624)) <> "" Then
T = T + 1
rgRecap.Offset(T, 22) = .Range(Cells(I, 624), Cells(I, 624))

End If
Next I

' OPL

ligndebut = 30
lignfin = 1000

' rgRecap.Offset(0, 21) = .Range("E28")

For I = ligndebut To lignfin

If .Range(Cells(I, 629), Cells(I, 629)) <> "" Then
U = U + 1
rgRecap.Offset(U, 23) = .Range(Cells(I, 629), Cells(I, 629))

End If
Next I

Dans ce code on retrouve toutes les plages de données que je veux copier à partir de l'onglet "Temps" de mes fichiers Excel.

Merci encore pour votre aide.

PS : Dsl si mes messages sont trop lourds.

Pour te donner une idée comment procéder :

Copie cette procédure dans le classeur où tu veux récupérer la compilation
des données.

Cette procédure copie toute la totalité de la feuille de chaque classeur à
ouvrir
vers la feuille du fichier de compilation. Si tu ne désires pas copier toute
la feuille
tu as le principe général comment procédure. Si tu as des questions précises
à
formuler, n'hésite pas.

Attention, tu dois définir correctement ton répertoire principal ici dans la
procédure.
'Répertoire de départ à définir...
Répertoire = "C:UsersTon profilDocuments"

'---------------------------------------------------------------------
Sub test()
Dim Fs As Object, F As Object, Répertoire As String
Dim Fichier As Object, MonFichier As String
Dim Wk As Workbook, Dest As Workbook, Compteur As Long
Dim DerLig As Long, DerCol As Long, LastRow As Long

'Répertoire de départ à définir...
Répertoire = "C:UsersTon profilDocuments"
On Error Resume Next
Set Dest = ThisWorkbook

Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(Répertoire)

Application.ScreenUpdating = False
Application.EnableEvents = False
For Each Fichier In F.SubFolders
MonFichier = Dir(Fichier & "" & "*.xl*")
If Err = 0 Then
Do While MonFichier <> ""
With Dest
With .Worksheets("Liste FT")
If .Range("A1") <> "" Then
LastRow = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Else
LastRow = 1
End If
End With
Workbooks.Open (Fichier & "" & MonFichier)
Set Wk = ActiveWorkbook
If Not IsEmpty(Wk.Worksheets("Temps").UsedRange) Then
With Wk
'détermine la ligne où l'info du fichier à ouvrir sera
copiée dans
'le fichier de compilation
With .Worksheets("Temps")
DerLig = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

'La copie se fait ici
Compteur = Compteur + 1
If Compteur = 1 Then
.Range("A1", .Cells(DerLig, DerCol)).Copy _
Dest.Worksheets("Liste FT").Range("A" &
LastRow)
Else
.Range("A2", .Cells(DerLig, DerCol)).Copy _
Dest.Worksheets("Liste FT").Range("A" &
LastRow)
End If
End With
End With
End If
Wk.Close False
MonFichier = Dir()
End With
Loop
Else
Err.Clear
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'---------------------------------------------------------------------

Le mardi 28 Janvier 2014 à 11:58 par Modjow :

Bonjour,

Voici mon problème :

Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).

Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)

J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.

Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.

Merci d'avance pour l'attention que vous accorderez à mon petit
problème!

Merci, j'essai ton code et je te tien au courant au plus vite!

Le mardi 28 Janvier 2014 à 11:58 par Modjow :

Bonjour,

Voici mon problème :

Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).

Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)

J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.

Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.

Merci d'avance pour l'attention que vous accorderez à mon petit
problème!

J'ai essayé ton code en l'integrant dans un bouton, j'ai mis le repertoire souhaité à la place de "C:UsersTon profilDocuments" mais rien ne se passe. Faut-il que je modifie autre chose dans le code?

essaie ceci :

'----------------------------------------------------------
Sub test()
Dim Fs As Object, F As Object, Répertoire As String
Dim Fichier As Object, MonFichier As String
Dim Wk As Workbook, Dest As Workbook, Compteur As Long
Dim DerLig As Long, DerCol As Long, LastRow As Long

'Répertoire de départ à définir...
Répertoire = "C:UsersTon ProfilDocuments"
'On Error Resume Next
Set Dest = ThisWorkbook

Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(Répertoire)

Application.ScreenUpdating = False
Application.EnableEvents = False
For Each Fichier In F.SubFolders
MonFichier = Dir(Fichier & "" & "*.xl*")
If Err = 0 Then
Do While MonFichier <> ""
With Dest
With .Worksheets.Worksheets("Liste FT")
If Not IsEmpty(.UsedRange) Then
LastRow = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Else
LastRow = 1
End If
End With
Workbooks.Open (Fichier & "" & MonFichier)
Set Wk = ActiveWorkbook
If Not IsEmpty(Wk.Worksheets("Temps").UsedRange) Then
With Wk
'détermine la ligne où l'info du fichier à ouvrir sera
copiée dans
'le fichier de compilation
With .Worksheets("Temps")
If Not IsEmpty(.UsedRange) Then
DerLig = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Else
DerLig = 1: DerCol = 1
End If

'La copie se fait ici
Compteur = Compteur + 1
If Compteur = 1 Then
.Range("A1", .Cells(DerLig, DerCol)).Copy _
Dest.Worksheets("Liste FT").Range("A" &
LastRow)
Else
.Range("A2", .Cells(DerLig, DerCol)).Copy _
Dest.Worksheets("Liste FT").Range("A" &
LastRow)
End If
End With
End With
End If
Wk.Close False
MonFichier = Dir()
End With
Loop
Else
Err.Clear
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'---------------------------------------------------------------------

Le mardi 28 Janvier 2014 à 11:58 par Modjow :

Bonjour,

Voici mon problème :

Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).

Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)

J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.

Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.

Merci d'avance pour l'attention que vous accorderez à mon petit
problème!

J'ai une erreur de compilation "Memebre de méthode ou de donnée introuvable" qui apparait dans la ligne :

With .Worksheets.Worksheets("Liste FT")

L'erreur vien du 2eme .Worksheets