Copier nom de plusieurs fichiers

[caskad]

Bonjour à tous,


Voila, j'ai un petit souci concernant la création d'un tableau récapitulatif.
Plusieurs collèges doivent me faire parvenir l'inventaire de leur consommation annuel, j'ai donc une fiche qui récapitule tout.

Mais j'ai voulu automatiser cela afin que la secrétaire n'y passe pas trop de temps.

Seulement, j'ai un souci:

J'ai réussi en grappillant des bouts de code(merci à ce fabuleux forum) à effectuer une macro qui va chercher au préalable dans un répertoires tout les fichiers de chaque collèges (ça peut donc varier).

cette macro ouvre le premier fichier et copie la colonne qui m’intéresse puis la colle dans le classeur récapitulatif.

Le problème est que je boucle tout les fichiers du repertoire et que les colonnes s’incrémentent parfaitement mais de façon inverse (Selection.Insert Shift:=xlToRight) mais les noms de fichiers eux sont dans le désordre ^^:

Sub démarrer()
 
unrép = Dir("c:\récapitulatif besoin\*.xls", vbDirectory) '// Extrait la première entrée
   Do While unrép <> ""    ' Commence la boucle.
      j = i + 3
Workbooks.Open Filename:="c:\récapitulatif besoin\" & unrép
    
    
    
    Worksheets("Feuil1").Activate
    Range("c3:c676").Select
    Selection.Copy
    
    Windows("ETAT RECAPITULATIF BESOINS DENREES ALIMENTAIRES_Marchés  2011 .xls").Activate
    Worksheets("feuil1").Activate
    
    Cells(j, 5).Select
    Selection.Insert Shift:=xlToRight
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows(unrép).Close False
  unrép = Dir
  
   Loop
Call finale
End sub

bon cela fait ce que je souhaite à 50% car mon souci principale réside dans le fait que je souhaite ajouter le nom du fichier qui indiquera le nom du collège pour chaque colonne sur une ligne 3 (E3 jusqu'a AB3).

Je vous joins un exemple, désolé si le code est pas propre et que plein de module mais je suis assez novice il faut mettre le répertoire dans C:

Si quelqu’un pouvait m'aider ce serait du bonheur car je ne vois pas trop comment faire ma solution n'est pas viable à 100%

merci par avance !

 

[kjin]

Re : Copier nom de plusieurs fichiers

Bonjour,
Pas sûr d'avoir vraiment compris mais bon

Sub démarrer()
Dim ws As Worksheet, wb As Workbook, Tablo
Dim col&, rep$, f$
Set ws = ThisWorkbook.Sheets("feuil1")
col = ws.Cells(3, 256).End(xlToLeft).Column + 1
rep = "C:\récapitulatif besoin\"
f = Dir(rep & "*.xls")
Application.ScreenUpdating = False
Do While f <> ""
    Set wb = Workbooks.Open(rep & f)
    With wb.Sheets("Feuil1")
        Tablo = .Range(.[C4], .[C65000].End(xlUp)).Value
    End With
    wb.Close False
    With ws
       .Cells(4, col).Resize(UBound(Tablo), 1) = Tablo
       .Cells(3, col) = Left(f, Len(f) - 4)
    End With
    col = col + 1
    f = Dir
Loop
'Call finale
Application.ScreenUpdating = False
End Sub

A+
kjin

 

[caskad]

Re : Copier nom de plusieurs fichiers

Merci beaucoup Kjin,

ton aide est précieuse, ca semble être au poils !