Réunir les feuilles des autres fichiers excel dans un seul

[P96O1004]

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 coucou.xls. Première feuille (nommée Update), je vais mettre un bouton : "Update". 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 1 "Update", 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 : récupérer l'adresse actuelle de fichier coucou.xls
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)

Pourriez vous me donner des conseils et des formules nécessaire ? Je vais compléter le macro de temps en temps et espérer finir dans 3 jours.

Merci bien à tous !!! et mes amis vous dit merci aussi

 

[jp14]

Re : Réunir les feuilles des autres fichiers excel dans un seul

Bonjour

Un problème similaire

https://www.excel-downloads.com/thr...s-vers-une-base-de-donnees-nominative.115026/

JP

 

[P96O1004]

Re : Réunir les feuilles des autres fichiers excel dans un seul

après une nuit, je suis bloqué sur le code pour récupérer le premier termes de nom des fichiers. Quelqu'un peut m'aider pls ?

(si excel peut marcher comme BASH, ce dernier ne pose pas de problème )

 

[P96O1004]

Re : Réunir les feuilles des autres fichiers excel dans un seul

J'arrive à copier les donnes mais pas de feuille :
J'ai corrigé un peu et là je suis perdu :

code : (partie rouge bloqué)

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

Dossier contient les fichiers + macro pour tester :
(lien télécharger direct)

Merci bien.

 

[jp14]

Re : Réunir les feuilles des autres fichiers excel dans un seul

Bonjour

Ci dessous une procédure à tester

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
Dim classeur1 As String
Dim i As Long
Dim Sh As Worksheet
'**********************************
sFolderName = ThisWorkbook.Path & "\"
classeur1 = ActiveWorkbook.Name

Application.ScreenUpdating = False 'gele l'ecran
Application.DisplayAlerts = False 'interdit les messages d'avertissements
    ' 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 Each Sh In Workbooks(sFname).Worksheets
           If Sh.Name = "Global vision" Then
                i = Workbooks(classeur1).Worksheets.Count
                Workbooks(sFname).Sheets("Global vision").Copy _
                Before:=Workbooks(classeur1).Sheets(i)
                Sheets("Global vision").Select
                Sheets("Global vision").Name = Replace(sFname, ".chain.xls", "")
                Exit For
           End If
        Next Sh
      Workbooks(sFname).Close False
      sFname = Dir
   Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

JP