Synthese

Pio -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Je possède sur un projet n fiches évolutions. Le format et le même pour toutes ces fiches.
FEPP_1
FEPP_2
FEPP_n

Je voudrais faire un copier/coller de certaines cellules de tous ces fichiers afin d'obtenir une synthèse.

Merci pour votre aide

Slts
Pio

Configuration: Android / Chrome 81.0.4044.117

2 réponses

  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour,
    qu'as-tu essayé, quel obstacle as-tu rencontré?
    0
  2. Pio.roro
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      tu peux, par exemple, copier ainsi:
      Workbooks("EVOLUTION FEP.xlsm").sheets("nomdelafeuille").cells(DerLigne,"E")= _
         Workbooks(NomClasseur).sheets("nomdelautrefeuille").[C9]

      ou bien
      dim fsource as worksheet, fdest as worksheet
      set fsource=Workbooks(NomClasseur).sheets("nomdelautrefeuille")
      set fdest=Workbooks("EVOLUTION FEP.xlsm").sheets("nomdelafeuille")
      fdest.cells(DerLigne,"E")= fsource.[C9]
      0
    2. Pio.roro > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
       
      Je dois extraire les données des cellule (B11; K9...) dans les fichiers FEP ( nº 1; nº 2; nº3, ....) et les copier dans le fichier de synthèse EVOLUTION FEP. Feuille Suivi FEP
      Comment je fais pour consolider chaque FEP dans le tableau de synthèse par ligne?

      Je suis perdu!
      0
    3. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > Pio.roro
       
      tu n'as toujours pas utilisé les balises de code.
      comprends-tu le code que tu as partagé?
      as-tu une question au sujet du code que j'ai partagé?
      0
    4. Pio.roro Messages postés 1 Statut Membre > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
       
      Hello
      Mon code oui. Le votre non.
      Je ne suis pas un expert en programmation.
      La déclaration des variables, non plus.
      0