Sub Bouton2_Cliquer()
Dim Fichier, Dossier_actif, Nom_Fichier
Dim donne(50)
Application.ScreenUpdating = False 'Evite sautillement d'ecran
Application.DisplayAlerts = False
Chemin = ActiveWorkbook.Path 'Donne le chemin du classeur actif
Fichier_actif = ActiveWorkbook.Name 'Donne le nom du classeur actif
Set Dossier_actif = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin).Files 'dossier actif
For Each Fichier In Dossier_actif 'pour chaque fichier dans ce dossier
Nom_Fichier = Fichier.Name 'mémorise les noms des fichiers du dossier un après l'autre
b = Right(Nom_Fichier, 4) 'b= extension du fichier (xlsm)
If Left(Nom_Fichier, 1) <> "~" Then
If b = "xlsm" And Nom_Fichier <> ActiveWorkbook.Name Then 'Si extension= xls et ce fichier <> de "Recapitulatif" alors
Workbooks.Open Filename:=Chemin & "\" & Nom_Fichier ' ouvrir ce fichier
Sheets("Item Details").Activate 'activer feuille "Item Details"
Dim SheetName As String
SheetName = ActiveSheet.Name
Range("b4").Select
rowc = 0
Do While (ActiveCell.Value <> "-")
If (ActiveCell.Value <> "-") Then
rowc = rowc + 1
ActiveCell.Offset(1, 0).Select
Else
Exit Do
End If
Loop
Sheets("Cover").Activate 'activer feuille "Cover"
donne(2) = Cells(22, 7)
donne(3) = Cells(16, 7)
donne(4) = Cells(17, 7)
donne(6) = Cells(18, 7)
Sheets("Summary").Activate 'activer feuille "Summary"
donne(1) = Cells(1, 3)
donne(7) = Cells(6, 4)
donne(8) = Cells(8, 4)
donne(9) = Cells(9, 4)
donne(10) = Cells(13, 4)
donne(11) = Cells(14, 4)
donne(12) = Cells(15, 4)
donne(13) = Cells(16, 4)
donne(14) = Cells(17, 4)
donne(15) = Cells(18, 4)
donne(16) = Cells(19, 4)
donne(17) = Cells(20, 4)
donne(18) = Cells(21, 4)
donne(19) = Cells(22, 4)
donne(20) = Cells(23, 4)
donne(21) = Cells(24, 4)
donne(34) = Cells(32, 9)
donne(35) = Cells(23, 9)
donne(36) = Cells(23, 10)
Sheets("Item Details").Activate 'activer feuille "Item Details"
donne(22) = Cells(4, 1)
donne(23) = Cells(4, 2)
donne(24) = Cells(4, 3)
donne(25) = Cells(4, 4)
donne(26) = Cells(4, 6) 'z
donne(27) = Cells(4, 8)
donne(28) = Cells(4, 10)
donne(29) = Cells(4, 12)
donne(30) = Cells(4, 13)
donne(31) = Cells(4, 16)
donne(32) = Cells(4, 17)
donne(33) = Cells(4, 20)
ActiveWorkbook.Close 'fermer ce classeur
Windows(Fichier_actif).Activate 'activer (Recapitulatif)
Sheets("Tracker").Activate ' activer feuille
num = Cells.Find("*", , , , , xlPrevious).Row 'recherche de la derniere ligne ecrite
For i = 1 To 36
Cells(num + 1, i) = donne(i)
Next i
End If
End If
Next 'suivant
End Sub