[RESOLU] Extraire données de plusieurs fichiers sources vers un fichier récap

[sasha_na]

Bonjour à tous,

Je cherche à créer une macro permettant d'importer des données issues de plusieurs fichiers sources (.xls) vers un fichier récapitulatif (xls)
Un dossier contient ces fichiers sources qui sont ajoutés manuellement.
La macro doit donc implémenter au fur et à mesure les lignes du fichier récap avec les données des fichiers sources ajoutés.
Voici la macro que j'ai trouvée et modifiée pour qu'elle réponde à mon besoin. Aucun bug ne s'affiche, le msgbox ajouté à la fin de la macro fonctionne, j'imagine donc que la macro entière devrait fonctionner... Mais ca n'est pas le cas!

Je ne connais plus ou moins rien en VBA, j'ai sans doute manqué une étape.. Pourriez-vous m'aider à y voir plus clair?

Merci d'avance !

Sub Importfiles()

'/Fichier récapitulatif, la feuille "données" de ce fichier
Set wbRecap = ThisWorkbook
Set wsRecap = wbRecap.Sheets("DONNEES")
Dim Fichier As String, Chemin As String
Dim Wb As Workbook
Chemin = "C:\Documents and Settings\Desktop\FNC"
Fichier = Dir(Chemin & "*.xls")
Do While wbSource <> «»

'/Ouvre le fichier actuel à importer
Set wbSource = Workbooks.Open(Chemin & Fichier)

'/Sélectionne la feuille de données à importer.
Set wksNewSheet = wbSource.Sheets("EVAL FNR ")

'/ Active cette feuille
wksNewSheet.Activate
wksNewSheet.Select

'/Sélection des données que l'on veut importer
Range("A4,F1,F3,D6,D7,F17, F25, F32, F39").Select

'/Copie les données sélectionnées
Selection.Copy

'/Retourne vers le fichier de départ
wbdest.Activate

'/Compte le nombre de lignes déjà utilisées dans ce fichier
i = ActiveSheet.UsedRange.Rows.Count

'/ Sélectionne la cellule où l'on veut coller les données (la première ligne vide)
Range("i+1,1, i+1,2, i+1,3, i+1,4,i + 1, 6, i + 1, 7, i + 1, 8").Select

'/Colle les données
ActiveSheet.Paste

'/Ferme le fichier source
wbSource.Close

'/Va vers le fichier suivant à importer
Fichier = Dir

'/Recommence avec le fichier suivant
Loop
wbRecap.Activate

MsgBox "OK"

End Sub

 

[sasha_na]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

Bonjour,

Bon le sujet n'a pas l'air d'intéresser des masses !
Mais je vous avoue que je suis vraiment bloquée, et je serai vraiment super reconnaissante à celui qui voudrait bien y jeter un petit coup d'oeil. Si je n'ai pas été claire, je détaillerai avec plaisir.
J'aimerai juste savoir pourquoi ma macro ne fonctionne pas, il y manque surement pleins de choses vu mon niveau inexistant en VBA, mais le debugger ne me bombarde plus de messages bloquants alors.. mystère !

Merci d'avance à l'âme charitable qui se lancera dans le sujet !

 

[titiborregan5]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

Bonjour sasha_na, le forum,

est-ce que tu vois tes fichiers avec les données s'ouvrir?

Imaginons que tu as une feuille récup dans ton fichier d'accueil.

la macro suivante te récupère les différents fichiers

Sub reCup_liste()
rePertoire = "L:\sg\budget\echange\Budget\Budget 2014\BI 2014\Directions\Retours\Copie\" 'là où sont les fichiers
 With Sheets("récup")
 .Columns("a").ClearContents 'efface la colonne A de la feuille récup
 i = 2
 nf = Dir(rePertoire & "*BI 2014*.xls")  ' premier fichier
 Do While nf <> ""
 .Cells(i, 1) = nf 'écrit le nom du fichier
 nf = Dir ' suivant
 i = i + 1
 Loop
 End With
 End Sub

Ensuite pour ouvrir chaque fichier et récupérer la feuille appelée T1 (à adapter à ton cas) et la copier coller ici à la suite...

Sub reCup_T1()
rePertoire = "L:\sg\budget\echange\Budget\Budget 2014\BI 2014\Directions\Retours\Copie\" 'là où sont les fichiers
With Sheets("récup")
On Error Resume Next
For i = 2 To .Range("a65000").End(xlUp).Row 'pour tous les fichiers présents
n = .Cells(i, 1) 'nom du fichier
nc = rePertoire & .Cells(i, 1) 'chemin & nom du fichier
nbf = ThisWorkbook.Sheets.Count 'compte le nombre de feuilles dans le classeur
Application.DisplayAlerts = False 'masque les alertes
Application.AskToUpdateLinks = False 'ne pas demander les mises à jour des liens
Workbooks.Open (nc) 'ouvre le classeur
service = Workbooks(n).Sheets("t1").Range("a65000").End(xlUp).Value 'le nom du service = dans fichier ouvert la dernière cellule remplie en A

Workbooks(n).Sheets("T1").Copy after:=ThisWorkbook.Sheets(nbf) 'copie la feuille T1 dans ce classeur après la dernière feuille
ThisWorkbook.Sheets(Sheets.Count).Name = service 'donne le nom du service à la feuille
Workbooks(n).Close 'ferme le classeur du service
Next

Voilà, après il faut adapter...j'essaie de regarder ça si j'ai le temps!

 

[sasha_na]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

Bonjour titiborregan5,

Tout d'abord merci beaucoup pour ta réponse.

Non, aucun des fichiers ne s'ouvrent et la seule chose qui se passe, c'est le msgbox OK que j'ai rajouté qui apparait.
Idem pour ta macro, elle efface bien la colonne A mais ensuite plus rien.
Si je comprends bien ta macro, elle sert à insérer les feuilles des fichiers sources les unes à la suite des autres dans le fichier récap, avec le nom du fichier dans un ''sommaire''?
Corrige moi si je me trompe..

En fait, ce dont j'ai besoin, c'est une extraction mais uniquement des données sources dans une seule feuille d'un fichier récap. Je te joins les fichiers, c'est toujours plus parlant.
Je pense que la macro que je propose est plus ou moins correcte, j'imagine que le bug doit venir des dénominations du début.
Je suis sous excel 2003, je ne sais pas si cela peut poser un problème à un moment?

Je continue à chercher de mon côté, pourrais tu jeter un coup d'oeil à la macro avec les PJs?

Merci d'avance.

 

[titiborregan5]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

Re,
quand tu fais le mode pas à pas (f8 dans ton code) il lit toutes les lignes?
Je n'ai vu aucun code dans tes fichiers...


Ma macro permet de lister les fichiers du répertoire voulu...
ensuite avec cette liste on va aller ouvrir chaque classeur de la liste et copier une feuille voulue...
Essaie de faire la 1ère étape, on verra après comment récupérer les valeurs précises!

regarde la pj ça devrait marcher (chez moi ça marche) par contre il faut que modifies les cellules à copier et leur ordre car ce que tu as mis dans le code de ton 1er message ne correspond pas aux colonnes du fichier récap...

le code au cas où:

Sub t()
rePertoire = "C:\Documents and Settings\xxx\Bureau\test\" 'là où sont les fichiers
 With Sheets(2)
 .Columns("a").ClearContents 'efface la colonne A de la feuille récup
 i = 2
 nf = Dir(rePertoire & "*.xls")  ' premier fichier
 Do While nf <> ""
 .Cells(i, 1) = nf 'écrit le nom du fichier
 nf = Dir ' suivant
 i = i + 1
 Loop
 
 For j = 2 To .Range("a65000").End(xlUp).Row 'pour tous les fichiers présents
n = .Cells(j, 1) 'nom du fichier
nc = rePertoire & n 'chemin & nom du fichier
'nbf = ThisWorkbook.Sheets.Count 'compte le nombre de feuilles dans le classeur
Application.DisplayAlerts = False 'masque les alertes
Application.AskToUpdateLinks = False 'ne pas demander les mises à jour des liens
Workbooks.Open (nc) 'ouvre le classeur
'service = Workbooks(n).Sheets("t1").Range("a65000").End(xlUp).Value 'le nom du service = dans fichier ouvert la dernière cellule remplie en A

Workbooks(n).Sheets(1).Range("a4").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(1, 0)
Workbooks(n).Sheets(1).Range("f1").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 1)
Workbooks(n).Sheets(1).Range("f3").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 2)
Workbooks(n).Sheets(1).Range("d6").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 3)
Workbooks(n).Sheets(1).Range("d7").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 4)
Workbooks(n).Sheets(1).Range("f17").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 5)
Workbooks(n).Sheets(1).Range("f25").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 6)
Workbooks(n).Sheets(1).Range("f32").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 7)
Workbooks(n).Sheets(1).Range("f39").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 8)

'ThisWorkbook.Sheets(Sheets.Count).Name = service 'donne le nom du service à la feuille
Workbooks(n).Close 'ferme le classeur du service
Next

.Columns("a").ClearContents 'efface la colonne A de la feuille récup

 End With
 
End Sub

a+

 

[sasha_na]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

Bonjour titiborregan5,

J'ai bien modifié les colonnes, ca marche presque!!
Par contre je rencontre deux problèmes que je n'arrive pas à résoudre:
-Le fait d'écrire puis d'effacer le nom des fichiers en colonne A me créé un décalage de x lignes (en fonction du nombre de fichiers présents dans le dossier source). J'ai essayé en gardant le nom du fichier, mais ce décalage reste.
Est-il possible d'aligner les données avec le nom de leur fichier source?

-Les données que je souhaite copier sont le résultat de formules SI. Lorsque l'extraction se fait dans le dossier récap, ce n'est pas les valeurs qui apparaissent mais leur formule (donc =0)
J'ai tenté ces types de code, mais ce n'est vraiment pas concluant:
Workbooks(n).Sheets(1).Range("a4").Value ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 0).Value

Workbooks(n).Sheets(1).Range("f3").Copy ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(0, 1).PasteSpecial_xlPasteValues
Aurais-tu une autre solution pour copier uniquement les valeurs?

J'ai mis mes résultats en PJ.

Bonne journée à toi et merci pour ton aide!

 

[titiborregan5]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

impossible d'ouvrir ton zip...

pour copier coller en valeur, 2 possibilités:

- lui dire = ce qui pourrait donner :

ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(1, 0)=Workbooks(n).Sheets(1).Range("a4").Value

- passer par le copier coller en valeur (attention au saut de ligne après copy!!!)

Workbooks(n).Sheets(1).Range("a4").copy
ThisWorkbook.Sheets(1).Range("a65000").End(xlUp).Offset(1, 0).pastespecial paste:=xlpastevalues

Bon courage

 

[sasha_na]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

Ah magnifique pour le copy paste, c'est ca! Merci !
Je le note pour la prochaine.

Par contre, nouveau problème, j'espère le dernier.
Depuis que j'ai inclu le copy-paste, seule la dernière ligne du tableau se complète.
Si j'ai 32 fichiers, seule la 32eme ligne du dossier récap sera complétée.
Ce que je ne comprends pas, c'est que je n'ai modifié aucune autre donnée mis à part ce copy.
J'ai essayé de resoudre ca avec un Do While.. Loop sans grand succès.

Ci-joint le fichier avec la macro.
Vois-tu l'erreur quelque part?
J'apprends petit à petit mais je t'avoue que ca dépasse vraiment mon niveau..

 

[titiborregan5]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

Oui c'est normal ça vient de ton offset... qui n'a pas grand chose à faire là en fait...

essaie comme ça (à adapter et poursuivre je ne t'ai mis ici que les 2 1ers)

Workbooks(n).Sheets(1).Range("a4").Copy
ThisWorkbook.Sheets(1).Cells(j, 2).PasteSpecial Paste:=xlPasteValues
Workbooks(n).Sheets(1).Range("f3").Copy
ThisWorkbook.Sheets(1).Cells(j, 3).PasteSpecial Paste:=xlPasteValues

 

[sasha_na]

Re : Extraire données de plusieurs fichiers sources vers un fichier récap

Merci énormément pour ta patience, ca fonctionne à merveille.

Voici le code utilisé pour extraire les données de plusieurs fichiers vers une feuille récap:

Sub Import_files()
'Dossiers contenant les fichiers
rePertoire = "C:\Documents and Settings\broqueri\Desktop\FNC\"
With Sheets("DONNEES")
i = 2
nf = Dir(rePertoire & "*.xls") ' premier fichier
Do While nf <> ""
.Cells(i, 1) = nf 'écrit le nom du fichier
nf = Dir ' suivant
i = i + 1
Loop

For j = 2 To .Range("a65000").End(xlUp).Row 'pour tous les fichiers présents
n = .Cells(j, 1) 'nom du fichier
nc = rePertoire & n 'chemin & nom du fichier
Application.DisplayAlerts = False 'masque les alertes
Application.AskToUpdateLinks = False 'ne pas demander les mises à jour des liens
Workbooks.Open (nc) 'ouvre le classeur

'Copie Colle les valeurs
Workbooks(n).Sheets(1).Range("a4").Copy
ThisWorkbook.Sheets(1).Cells(j, 2).PasteSpecial Paste:=xlPasteValues
Workbooks(n).Sheets(1).Range("f3").Copy
ThisWorkbook.Sheets(1).Cells(j, 3).PasteSpecial Paste:=xlPasteValues
Workbooks(n).Sheets(1).Range("d6").Copy
ThisWorkbook.Sheets(1).Cells(j, 4).PasteSpecial Paste:=xlPasteValues
Workbooks(n).Sheets(1).Range("d7").Copy
ThisWorkbook.Sheets(1).Cells(j, 5).PasteSpecial Paste:=xlPasteValues
Workbooks(n).Sheets(1).Range("f17").Copy
ThisWorkbook.Sheets(1).Cells(j, 7).PasteSpecial Paste:=xlPasteValues
Workbooks(n).Sheets(1).Range("f25").Copy
ThisWorkbook.Sheets(1).Cells(j, 8).PasteSpecial Paste:=xlPasteValues
Workbooks(n).Sheets(1).Range("f32").Copy
ThisWorkbook.Sheets(1).Cells(j, 9).PasteSpecial Paste:=xlPasteValues
Workbooks(n).Sheets(1).Range("f39").Copy
ThisWorkbook.Sheets(1).Cells(j, 10).PasteSpecial Paste:=xlPasteValues

Workbooks(n).Close 'ferme le classeur du service
Next

End With

End Sub

 

[ABDELHAK]

Re : [RESOLU] Extraire données de plusieurs fichiers sources vers un fichier récap

Bonjour à tous,


J’ai beau essayé mais je n’y arrive pas. Le résultat que j’obtiens est très surprenant. En effet, la macro me copie que les noms des fichiers.
S’il vous plait, pouvez-vous m’aider à voir + clair.
Je joins un fichier test.
Dans tous les cas, je vous suis éternellement reconnaissant pour ce que vous avez déjà fait pour moi.

Amicalement vôtre

ABDELHAK