Sub Bouton1_Cliquer()
Dim FichierMacro As String
Dim Chemin As String
Dim DossierDB As String
Dim FichierDB As String
Dim NomOnglet As String
Dim WBc, WBs, sh
FichierMacro = ActiveWorkbook.Name
Chemin = ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
DossierDB = Sheets("Macro").Range("A2")
If DossierDB <> "" Then
FichierDB = Dir(Chemin & "\" & DossierDB & "\SX*.xls")
Set WBc = ThisWorkbook
Set WBs = Workbooks("FichierDB")
For Each sh In WBc.Sheets
If sh.Name = WBs.ActiveSheet.Name Then
Do Until FichierDB = ""
Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False
Windows(FichierMacro).Activate
Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
Rows("7:7").Select
Range(Selection, Selection.End(xlDown)).ClearContents
Workbooks(FichierDB).Activate
Rows("7:1000").Select
Selection.Copy
Windows(FichierMacro).Activate
ActiveSheet.Paste
Workbooks(FichierDB).Activate
ActiveWorkbook.Close True
Application.Wait (Now + TimeValue("00:00:01"))
FichierDB = Dir
Loop
Else
Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False
Workbooks(FichierDB).Activate
Cells.Select
Selection.Copy
Windows(FichierMacro).Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 85
Application.CutCopyMode = False
With Workbooks(FichierDB).ActiveSheet
NomOnglet = .Name
Windows(FichierMacro).Activate
ActiveSheet.Name = NomOnglet
End With
End If
Next
End If
Sheets("Macro").Select
ActiveCell.Offset(1, 0).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("La compilation est terminée")
End Sub