importation de plusieurs fichiers.xls

Re : importation de plusieurs fichiers.xls

Bonjour

Un exemple dans ce fil
https://www.excel-downloads.com/threads/recuperation-deuil-sur-un-mois.130176/


JP

Re : importation de plusieurs fichiers.xls

Bonjour,

La macro ci-dessous me conviendrait parfaitement, mais il faudrait juste m'aider à modifier quelques paramètres.

1. Il n'y aurait qu'un seul répertoire et non plusieurs ou se trouvent mes fichiers.

2. Le noms à mettre sur mes feuilles se serait le nom des fichiers importés et c'est tout.

Pourriez-vous m'aider à modifier la macro ci-dessous selon les paramètres ci-dessous.

***************
Sub Import()
Dim dossierAnalyse As Object, sousDossierAnalyse As Object, fichierAnalyse As Object
Dim pathDossierAnalyse As String, nomFichier As String, nomOnglet As String, moisAnalyse As String, anneeAnalyse As String
Dim tabStr() As String, wbk As Workbook, sht As Worksheet

'****** Définir les variables de la macro ******
pathDossierAnalyse = "H:\Synthèse"
nomFichier = "toto.xls"
nomOnglet = "test"
moisAnalyse = "10"
anneeAnalyse = "09"
'***********************************************

'récupérer le dossier analysé
Set dossierAnalyse = CreateObject("Scripting.FileSystemObject").GetFolder(pathDossierAnalyse)

'boucler sur tous ses sous-dossier
For Each sousDossierAnalyse In dossierAnalyse.SubFolders

'récupérer la date (nom du sous-dossier) dans un tableau
tabStr = Split(sousDossierAnalyse.Name, "_")

'si le sous dossier fait partie du mois et de l'année analysés
If tabStr(1) = moisAnalyse And tabStr(2) = anneeAnalyse Then

'boucler sur tous les fichiers du sous-dossier
For Each fichierAnalyse In sousDossierAnalyse.Files

'si le fichier porte les bon nom
If fichierAnalyse.Name = nomFichier Then

'ouvrir le fichier en lecture seule
Set wbk = Application.Workbooks.Open(fichierAnalyse.Path, , True)

'boucler sur tous les onglets du fichier
For Each sht In wbk.Sheets

'si l'onglet courant porte le bon nom
If sht.Name = nomOnglet Then

With ThisWorkbook

'copier l'onglet à la suite des onglets de ce classeur
sht.Copy after:=.Sheets(.Sheets.Count)

'renommer le nouvel onglet de ce classeur avec le numéro du jour
.Sheets(.Sheets.Count).Name = tabStr(0)

End With
End If
Next sht

'fermer le classeur (sans enregistrer les changements
wbk.Close False
End If
Next fichierAnalyse
End If
Next sousDossierAnalyse

'détruire les objets
Set dossierAnalyse = Nothing
End Sub
*********************
Merci d'avance.

Soleil11