XL 2010 [Macro] Besoin d'aide pour copie de données via macro sur grand nombre de dossiers

Ma dernière tentative a été d'utiliser cette macro:
_______________________________________________________________________________________________________________________
'------------------------------------------------------------------------------
' Macro qui permet de compiler les informations contenues dans
' différents fichier pour les regrouper dans un fichier récapitulatif
' GCXL
'-------------------------------------------------------------------------------
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 DernLign As Integer 'ligne où on écrit les données
Dim vFichiers As Variant 'noms des fichiers
Dim i As Integer, k As Integer
Dim rgRecap As Range 'plage où on copie les données

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)) '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 + 1 '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)
rgRecap = Time
With wsSource
rgRecap.Offset(0, 1) = .Range("B7")
rgRecap.Offset(0, 2) = .Range("B8")
rgRecap.Offset(0, 3) = .Range("B10")
rgRecap.Offset(0, 4) = .Range("B13")
rgRecap.Offset(0, 5) = .Range("B14")
End With

wbSource.Close 'fermer fichier
Set wbSource = Nothing
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Next k

Application.ScreenUpdating = True
Application.StatusBar = False

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

_______________________________________________________________________________________________________________________

En adaptant les plages de copie mais pareil, je me retrouve face à un mur.... Celui d'arriver à sélectionner des cellules précises et les intégrer dans une ligne précise...

erreur de sujet

herve62 à dit:

Bonsoir
Coup de BOL , j'ai créé une appli similaire il y a 10 ANS !!! et surtout gardé dans mon grenier !!
donc j'ai repris le code et adapté à ton cas , juste 1h de boulot
La méthode à appliquer :
créer un dossier spécifique avec tous les fichiers à traiter + ce fichier avec le code ( Projet_Recap) comme dans le dossier joint ; Je demande le chemin du répertoire de traitement
Le fichier va regarder dans ce répertoire et prendre fichier par fichier ( qui sont à traiter)
Toutes les données requises de chaque fichier seront recopiées ligne à ligne dans ce fichier
ci joint mon exemple de dossier avec ton fichier exemples que j'ai dupliqué pour tester la boucle et le fichier vba
La boucle peut aller jusqu'à 200 si + changer le DIM du tableau
Espérant que cela te convienne

Cliquez pour agrandir...

Bonjour Hervé!!

Je te remercie infiniment!!!

Je me suis permis de copier ta macro et je vais travailler dessus car elle répond parfaitement au besoin mais en plus à tout un ensemble d'autres besoins!!!!!

Merci encore infiniment!!!

Bonjour
Très heureux que cela te convienne ; Je ne savais pas, il y a 10 ans, que cela resservirait !
De ce fait j'ai mis la sub complète avec le test d'un ( ou +) fichier ouvert au cas ou et si oui le ferme? sinon ça plante
les modifs :
Un Dim de + (Nom_fic)
La boucle de test ouvert
la fonction test fic _ouvert dans le module
Bonne poursuite