Synthese

bonjour,
qu'as-tu essayé, quel obstacle as-tu rencontré?

Hello

Voici le CODE:
--> Je ne sais comment coller dans le ficheir des synthèses les cellules que j'ai besoin.

Option Explicit

'Declaration de variable
Dim NomClasseur As String
Dim DerLigne As Integer
Dim DerLigneTable As Integer

'Procédure permettant la consolidation de pluseiurs classeurs

Sub Consolider()

'Etape nº1 : Création des en-têtes
'On reinitialise le fichier synthèse à chaque démarrage
Columns("A:AA").Clear

Range("A10").Value = "PRG"
Range("B10").Value = "SERVICE"
Range("C10").Value = "NºFEP"
Range("D10").Value = "DATE"
Range("E10").Value = "RESPONSABLE"
Range("F10").Value = "MP"
Range("G10").Value = "DESIGNATION"
Range("H10").Value = "REFERENCE"
Range("I10").Value = "INTITULE"
Range("J10").Value = "BEP"
Range("K10").Value = "BEM"
Range("L10").Value = "MTC"
Range("M10").Value = "QP"
Range("N10").Value = "QDP"
Range("O10").Value = "MDC"
Range("P10").Value = "LOP"
Range("Q10").Value = "HA"
Range("R10").Value = "PU"
Range("S10").Value = "INDUS"
Range("T10").Value = "MANUF"
Range("U10").Value = "DOM"
Range("V10").Value = "DATE DE CREATION"
Range("W10").Value = "RESP BE"
Range("X10").Value = "RESP CPPP"
Range("Y10").Value = "DELAI DE REPONSE"
Range("Z10").Value = "ACCORD LANCEMENT"
Range("A10:I10").Interior.Color = RGB(255, 204, 153) 'Couleur de remplissage
Range("J10:U10").Interior.Color = RGB(0, 0, 0) 'Couleur de remplissage
Range("V10:Z10").Interior.Color = RGB(255, 204, 153) 'Couleur de remplissage
Range("A10:I10").Font.Color = vbBlack 'Couleur de police
Range("J10:U10").Font.Color = vbWhite 'Couleur de police
Range("V10:Z10").Font.Color = vbBlack 'Couleur de police

'Etape nº 2: Parcourir tous les fichiers du dossier prédéfini
ChDir "C:\Users\pio.rodriguez\Desktop\FEP"

'on cherche le premier classeur dans un dossier
NomClasseur = Dir("C:\Users\pio.rodriguez\Desktop\FEP\*.xlsm")
'on boucle pour chercher tous les classeurs
While Len(NomClasseur) > 0
Application.DisplayAlerts = False 'Desactive les boites de dialogue Excel
Application.ScreenUpdating = False
Workbooks.Open NomClasseur 'Ouverture du classeur
Range("K11").Copy
Range("B11") 'Code Projet
Range("K9").Copy 'Service
Range("AI9").Copy 'Nº FEPP
Range("Q9").Copy 'DATE
Range("C9").Copy 'Responsable
Range("C11").Copy 'MP
Range("F10").Copy 'DESIGNATION
Range("AG13").Copy 'REFERENCE
Range("T16").Copy 'INTITULE
Range("BH12").Copy 'BEP
Range("BH17").Copy 'BEM
Range("BH24").Copy 'MTC
Range("BH29").Copy 'QP
Range("BD35").Copy 'QDP
Range("BV35").Copy 'MDC
Range("BH40").Copy 'LOP
Range("BH49").Copy 'HA
Range("BT49").Copy 'Pilote Usine
Range("AY58").Copy 'Industrialisation
Range("BV58").Copy 'Manufacturing
Range("BN64").Copy 'DOM
Range("D68").Copy 'DATE DE CREATION
Range("M68").Copy 'Responsable BE
Range("AI68").Copy 'CPP
Range("AC9").Copy 'Delai de réponse
Range("BN64").Copy 'date LANCEMENT
Range("AX61").Copy 'ACCORD LANCEMENT
Workbooks("EVOLUTION FEP.xlsm").Activate 'on revient sur le classeur
DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 'on recherche la dernière ligne vide de la feuille
Range("A10" & DerLigne).Select 'On se positionne sur la dernière ligne de la feuille
ActiveSheet.Paste 'Je colle les données
Workbooks(NomClasseur).Close 'Fermeture du classeur ouvert
NomClasseur = Dir 'On passe au prochain classeur

Wend

' DerLigneTable = ActiveSheet.UsedRange.Rows.Count + 1
Cells.EntireColumn.AutoFit 'On auto-ajuste les colonnes
Range("A1").Select

End Sub