Fusion de fichiers excel

[clood]

Bonjour à toutes et à tous

Je souhaites fusionner plusieurs fichier excel en un seul.
J'ai lu ce message (https://www.excel-downloads.com/threads/merger-des-fichiers.83849/) mais mes connaissances en vb sont trop limités pour pouvoir l'adapter ou en créé un nouveau.

J'ai environ 200 fichiers excel dans un même dossier avec des noms différents.
Ces fichiers sont composés chacun de 9 feuilles identiques.

Je souhaiterai automatiser la fusion, en ne copiant que la feuille qui s'appelle "Calcul" de chaque fichier dans un nouveau. Les cellules à copier de cette feuille "Calcul" vont de A1 à Z225.

Merci à ceux qui auront un peu de temps à consacrer à ma question.

 

[MichelXld]

Re : Fusion de fichiers excel

bonsoir

tu peux tester cet exemple qui utilise la bibliothèque ADO pour extraire toutes les données d'une feuille spécifique, dans tous les classeurs d'un répertoire.

Nécessite d'activer la référence Microsoft ActiveX Data Objects x.x Library


Les données sont importées à la suite dans la feuille active.

'Nécessite d'activer la référence
    'Microsoft ActiveX Data Objects x.x Library
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim xConnect As String, Cible As String
Dim Fichier As String, Dossier As String, Feuille As String
Dim i As Long
 
'nom du répertoire contenant les classeurs à regrouper
Dossier = "C:\nom dossier"
'Nom de la feuille dans les classeurs fermés
'Ne pas oublier le symbole $ après le nom de la feuille
Feuille = "Feuil1$"
i = 2
 
Fichier = Dir(Dossier & "\*.xls")
'boucle sur les fichiers du repertoire
Do While Len(Fichier) > 0
    xConnect = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
    "ReadOnly=1;DBQ=" & Dossier & "\" & Fichier
    'connection classeur
    Set Cn = New ADODB.Connection
    Cn.Open xConnect
    
    'Requete
    Cible = "SELECT * FROM [" & Feuille & "];"
    
    Set Rs = New ADODB.Recordset
    Rs.Open Cible, xConnect, adOpenStatic, adLockOptimistic, adCmdText
    
    'Ecriture dans la feuille de calcul
    If Not Rs.EOF Then Cells(i, 1).CopyFromRecordset Rs
    i = Cells(i, 1).End(xlDown).Row + 1
    
    Rs.Close
    Cn.Close
    Set Cn = Nothing
    Set Rs = Nothing
    Fichier = Dir()
Loop
 
MsgBox "Terminé"

bonne soirée
michel

 

[clood]

Re : Fusion de fichiers excel

Merci MichelXld !
Je vais tester ca et voir.