Sub TraitementFichiersExcel()
Dim dossier As String
Dim fichier As String
Dim classeur As Workbook
Dim classeurGlobal As Workbook
Dim feuilleGlobal As Worksheet
' Sélectionnez un dossier contenant les fichiers Excel à traiter
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Sélectionnez le dossier contenant les fichiers Excel à traiter"
If .Show = 0 Then Exit Sub ' L'utilisateur a annulé la sélection
dossier = .SelectedItems(1)
End With
' Désactivez les mises à jour pour améliorer les performances
Application.ScreenUpdating = False
' Crée un nouveau classeur pour les résultats
Set classeurGlobal = Workbooks.Add
Set feuilleGlobal = classeurGlobal.Sheets(1)
' Boucle à travers tous les fichiers du dossier
fichier = Dir(dossier & "\*.xls*")
Do While fichier <> ""
If fichier <> ThisWorkbook.Name And fichier <> "Global.xlsx" Then
' Ouvre le fichier Excel
Set classeur = Workbooks.Open(dossier & "\" & fichier)
' Supprime les lignes vides en bas de page et les colonnes vides à droite
Call SupprimerLignesColonnesVides(classeur.ActiveSheet)
' Copie les données dans le classeur de résultats
classeur.ActiveSheet.Copy After:=classeurGlobal.Sheets(classeurGlobal.Sheets.Count)
' Renomme l'onglet dans le fichier Global
classeurGlobal.Sheets(classeurGlobal.Sheets.Count).Name = Left(fichier, InStrRev(fichier, ".") - 1)
' Ferme le fichier source
classeur.Close SaveChanges:=False
End If
' Passe au fichier suivant dans le dossier
fichier = Dir
Loop
' Supprime la feuille initiale du classeur Global
Application.DisplayAlerts = False
classeurGlobal.Sheets(1).Delete
' Enregistre le classeur de résultats
classeurGlobal.SaveAs dossier & "\Global.xlsx", 51
Application.DisplayAlerts = True
' Ferme le classeur de résultats
classeurGlobal.Close SaveChanges:=True
' Réactivez les mises à jour
Application.ScreenUpdating = True
End Sub
Sub SupprimerLignesColonnesVides(feui As Worksheet)
If Application.CountA(feui.Cells) = 0 Then Exit Sub
' Supprime les lignes vides en bas de page
Dim derniereLigne As Long
derniereLigne = feui.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
feui.Rows(derniereLigne + 1 & ":" & feui.Rows.Count).Delete
' Supprime les colonnes vides à droite
Dim derniereColonne As Long
derniereColonne = feui.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
feui.Range(feui.Columns(derniereColonne + 1), feui.Columns(feui.Columns.Count)).Delete
End Sub