'Cette procédure recopie toutes les feuilles excels des fichiers contenu dans le même répertoire que le classeur courant dans le classeur courant
'Inspiré par http://www.excel-downloads.com/forum/98695-est-il-possible-de-fusionner-plusieurs-documents-excel-en-un-seul.html
Sub ConsoliderClasseurs()
Dim ClasseurMaitre As Workbook 'Classeur courant dans lequel les feuilles vont être copiées
Dim ClasseurCourant As Workbook
Dim FeuilleCourante As Object
Dim NbClasseurs As Integer 'Nombre de classeurs consolidés
Dim Compteur As Integer 'Compteur de noms de feuille identiques
Dim NomFichier As String
Dim NomFeuilleCourante As String
Dim Reponse As VbMsgBoxResult
Dim SupprimerFeuillesExistantes As Boolean
Dim ListeNomsFichiers As String 'Listes des noms des fichiers à consolider saisies par l'utilisateur
Dim NomsFichiers As Variant 'Noms des fichiers en cours de consolidation
Dim TabNomsFichiers As Variant 'Tableau des noms de fichiers à reconsolider
#If Debogage Then
Reponse = MsgBox("ATTENTION, débogage en cours, continuer ?", vbYesNo + vbExclamation)
If Not Reponse = vbYes Then Exit Sub
#End If
#If True Then ' Not Debogage Then
If ActiveWorkbook.Path = "" Then
MsgBox "Répertoire inconnu, vous devez utiliser un classeur enregistré.", vbCritical
Exit Sub
End If
#End If
Set ClasseurMaitre = ActiveWorkbook
'Faire saisir les extensions
ListeNomsFichiers = InputBox("Les noms des fichiers à consolider devraient être de la forme <nomfichier.extension> séparés par des virgules <,> les caratères génériques <*,?> peuvent être utilisés", "Saisir les extensions des fichiers à collecter", "*.xls?,*.csv")
If ListeNomsFichiers <> "" Then
TabNomsFichiers = Split(ListeNomsFichiers, ",")
Else 'Annulation
Exit Sub
End If
Reponse = MsgBox("Souhaitez-vous consolider les classeurs <" & Join(TabNomsFichiers, ", ") & "> du répertoire <" & ClasseurMaitre.Path & "> vers <" & ClasseurMaitre.Name & "> ?", vbQuestion + vbYesNo)
If Reponse <> vbYes Then Exit Sub
ChDir ClasseurMaitre.Path
If ClasseurMaitre.Sheets.Count <> 0 Then
Reponse = MsgBox("Le classeur <" & ClasseurMaitre.Name & "> contient déjà des feuilles, voulez-vous les supprimer ?", vbQuestion + vbYesNoCancel)
If Reponse <> vbYes And Reponse <> vbNo Then Exit Sub 'Annuler a été cliqué
Application.ScreenUpdating = False 'Empêche les màj de l'affichage
If Reponse = vbYes Then
SupprimerFeuillesExistantes = True
Application.DisplayAlerts = False
For Each FeuilleCourante In ClasseurMaitre.Sheets
If ClasseurMaitre.Sheets.Count <> 1 Then 'On ne peut pas supprimer toutes les feuilles d'un classeur
FeuilleCourante.Delete
Else
FeuilleCourante.Name = "FeuilleRestante"
End If
Next 'FeuilleCourante
Application.DisplayAlerts = True
Else
SupprimerFeuillesExistantes = False
End If
End If
NbClasseurs = 0 'Aucun classeur n'a été consolidé
For Each NomsFichiers In TabNomsFichiers
NomFichier = Dir(NomsFichiers)
Do While NomFichier <> ""
'On ne travaille pas avec le classeur dans lequel on consolide les feuilles
If NomFichier <> ClasseurMaitre.Name Then
'On ne travaille pas avec un classeur déjà ouvert pour éviter la gestion de l'enregistrement ou nom du fichier déjà ouvert
If Not EstDansCollection(Workbooks, NomFichier) Then
Set ClasseurCourant = Workbooks.Open(NomFichier, , True) 'Ouverture en lecture seule
For Each FeuilleCourante In ClasseurCourant.Sheets
'On gère la collision des noms car la longueur d'un nom de feuille est limitée à 31 caractères
'Excel gère cette collision avec au moins 5 caractères " (n)" contre 2 ici "_n"
'La première fois qu'un nom de feuille est rencontré on ne lui ajoute pas de numéro.
Compteur = 1 'Première fois
NomFeuilleCourante = FeuilleCourante.Name
Do
If Not FeuilleExiste(NomFeuilleCourante, ClasseurMaitre, se_ToutesFeuilles) Then Exit Do
Compteur = Compteur + 1 'Le nom a été rencontré une fois de plus
NomFeuilleCourante = Left(FeuilleCourante.Name, 31 - Len("_" & Compteur)) & "_" & Compteur
Loop
FeuilleCourante.Name = NomFeuilleCourante
FeuilleCourante.Copy After:=ClasseurMaitre.Sheets(ClasseurMaitre.Sheets.Count)
NbClasseurs = NbClasseurs + 1
If SupprimerFeuillesExistantes Then 'Teste un booléen pour accélerer les tests : feuilleexiste parcourt la liste des feuilles
If FeuilleExiste("FeuilleRestante", ClasseurMaitre, se_ToutesFeuilles) Then
Application.DisplayAlerts = False
ClasseurMaitre.Sheets("FeuilleRestante").Delete
SupprimerFeuillesExistantes = False
Application.DisplayAlerts = True
End If
End If
Next
ClasseurCourant.Close False 'On ferme sans sauvegarder car les noms des feuilles ont été modifiés
Else
Reponse = MsgBox("<" & NomFichier & "> est déjà ouvert, ses feuilles ne seront pas consolidées.", vbExclamation + vbInformation)
End If
End If
NomFichier = Dir
Loop
Next 'Extension
Application.ScreenUpdating = True 'Autorise les màj de l'affichage
If NbClasseurs = 0 Then MsgBox ("Aucun ficiers correpondants à <" & ListeNomsFichiers & "> n'a été trouvé")
End Sub
