Bonjour,

Mes amis ont un soucis sur Excel. Ils connaissent rien du tout VBA donc j'essaie de faire quelque chose.

Voila, il y un certains fichiers excel de forme identique avec 7 feuilles toujours de forme identique dans un dossier.
Les noms des fichier sont en forme : "j*.chain.xls"
Il faut récupérer la feuille numéro 5 (nom : Global vision) de tout les fichiers et les mettre dans un fichier excel (nommé Coucou par exemple). Les feuilles sont renommées en "j*" (premier termes du nom de fichier)

De temps en temps, il y aura des fichiers en supplémentaire. Donc je pense à créer un fichier Database.xls. Je vais mettre un bouton : "Update" en feuil 1. Quand on click le bouton, il va récupérer les feuilles "Global vision".

En gros, au début j'ai : j1.chain.xls, j4.chain.xls, j100.chain.xls ..
Après j'ai un fichier coucou.exel avec feuille numéro 2 est j1, 3 est j4, 4 est j100 ....

Je connais un peu VBA, mais j'ai du mal à commencer. J'ai pensé un logarithme :

1 : Je modifie code pour changer l'adresse
2 : lister les fichiers qui ont "chain.xls" dans le nom.
3 : un boucle :
+ pour chaque fichier récupérer le premier termes du nom
+ copier le feuille "Global vision"
+ renommer le et coller dans la feuille numéro 2 de coucou.xls
(continuer coller les autres feuilles "Global vision" dans les feuilles numéro 3, 4, 5... de coucou.xls)
Voilà le code : (partie rouge est celle je suis bloqué)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub collect()
Dim wsT As Worksheet
   Dim wsF As Worksheet
   Dim lRow(1) As Long
   Dim iCol As Integer
   Dim sFolderName As String
   Dim sFname As String
    
    ' insérer l'adresse de dossier
   sFolderName = "D:\documents and Settings\SESA117973\Desktop\Data base collection\"
    'chercher file
   
   sFname = Dir(sFolderName & "j*.xls")
   
   If sFname = vbNullString Then
      MsgBox "No .xls Files In" _
         & Chr(10) & Chr(10) _
         & sFolderName, vbInformation
      Exit Sub
   End If
   
   Set wsT = ThisWorkbook.Sheets("Resultats")
   Do Until sFname = vbNullString
      Workbooks.Open sFolderName & sFname
      Set wsF = Sheets("Global vision")
            For i = 2 To 40
                Sheets("Global vision").Copy After:=Sheets(i)
                ActiveSheet.Name = "Position " & i
                
            Next i

    
      ActiveWorkbook.Close False
      sFname = Dir
   Loop


End Sub


Merci bien