XL 2016 Compiler des cellules de différents fichiers Excel en un seul

[Val119]

Bonjour,

Je poste pour la première fois ici, j'ai tenté de trouver des solutions à mon problème mais impossible de trouver un topic correspondant à ma situation. Je vais essayer d'être le plus clair possible :

Situation initiale : J'ai actuellement 300 fichiers excel en format xlx dans un dossier sur mon bureau, ils ont tous la même trame. Le nom des fichiers sont fluctuants (pas forcement de logique).

Mon but : Compiler dans un fichier excel de synthèse CERTAINES cellules de chacun des fichiers. Le but étant de le mettre sous format d'un tableau. 1 ligne = 1 fichier. Cette ligne comportera : 19 colonnes correspondant aux 19 cellules que je dois récupérer dans les fichiers.
A la fin je dois avoir : 300 lignes de 19 colonnes remplies.

Dans ma tête j'ai une solution sous la main : l'utilisation de VBA. Je suis loin d'être expert en la matière. Cependant voici ce que j'ai en tête :

La macro doit comporter :
1) Démarrer du fichier de synthèse pour aller ouvrir dans le fichier répertoire le 1er fichier a extraire.
2) Lui ordonner de faire un premier copier coller de la première cellule pour la coller dans la synthèse
3) répartition de l'action pour chacune des cellules à C/C
4) Fermer le fichier et recommande sur l'ensemble des fichiers xlsx


Techniquement parlant : le fichier de synthèse se prénomme : "TrameEntretienPro" et le dossier dans lequel se trouve les fichiers à compiler : "Repertoire test" (sur mon bureau).
La première ligne à remplir commence : B4 et termine en T4
Les cellules à copier : F7 / F8 / F11 / B21 / B22 etc. (au total 19 cellules)

Pour le code du chemin :

Sub recup()
Range("A4").Select
Chemin = "C:\Users\XXXXXXX\Desktop\Repertoire test\"
Fichier = Dir(Chemin & "*.xls")
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Sheets("Sheet1").Select
Range("F7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("TrameEntretienPro.xlsx").Activate
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

....

Après je dois avouer que je cale un peu...
Si vous avez des idées, de l'aide à m'apporter je suis preneur...

Merci beaucoup à tous

 

[Lolote83]

Salut VAL119,
Sans fichier joint, difficile de pondre quelque chose.
Par contre, d'après ce que j'ai compris, et sans pouvoir tester, voici ce que cela pourrait donner (sans aucune certitude)

Sub Recup()
    Range("A4").Select
    Chemin = "C:\Users\XXXXXXX\Desktop\Repertoire test\"
    Fichier = Dir(Chemin & "*.xls")
    xOuvrirFichier = Chemin & Fichier
    Do While Fichier <> ""
        Workbooks.Open Filename:=xOuvrirFichier
        With Sheets("Sheet1")
            xDonnéeARécupérer = .[F8] & "%" & .[F9] & "%" & .[F11] & "%" & .[B21] & "%" & .[B22]
            xDécoupe = Split(xDonnéeARécupérer, "%")
        End With
        Windows("TrameEntretienPro.xlsx").Activate
        xDerLig = Range("B1000").End(xlUp).Row
        Range("B" & xDerLig & ":T" & xDerLig) = xDécoupe
        Workbooks(xOuvrirFichier).Close (False)
    Loop
End Sub

@+ Lolote83

 

[Val119]

Hello Lolote83 !

Merci pour ton retour. J'ai effectivement oublié de mettre le fichier en copie.
Cependant, j'ai réussi mon coup. Je pense pas que j'ai utilisé la méthode la plus simple... mais malgré tout je suis content j'ai bidouillé une macro qui marche.

En prenant en compte ton propos je suis à présent persuadé que je pouvais faire plus simple ! Même si cette tache est terminée je vais tenter avec ta méthode pour l'avenir

Sub Importfiles()

Dim NomFichier As String, Chemin As String

Chemin = "C:\Users\XXXXXXXXXX\Desktop\Repertoire test\"

NomFichier = Dir(Chemin & "*.xlsx")  'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire

Do While NomFichier <> ""  'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
Workbooks.Open Chemin & NomFichier  'ouvre le fichier actuel à importer

 With ActiveSheet
    .Range("F7").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("B" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("F8").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("C" & .Cells(.Rows.Count, "C").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("F11").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("D" & .Cells(.Rows.Count, "D").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("B21").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("E" & .Cells(.Rows.Count, "E").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("B22").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("F" & .Cells(.Rows.Count, "F").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("A84").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("G" & .Cells(.Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C94").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("H" & .Cells(.Rows.Count, "H").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C105").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("I" & .Cells(.Rows.Count, "I").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("A116").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("J" & .Cells(.Rows.Count, "J").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("D116").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("K" & .Cells(.Rows.Count, "K").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C130").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("L" & .Cells(.Rows.Count, "L").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C131").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("M" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C132").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("N" & .Cells(.Rows.Count, "N").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C133").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("O" & .Cells(.Rows.Count, "O").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C134").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("P" & .Cells(.Rows.Count, "P").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C135").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("Q" & .Cells(.Rows.Count, "Q").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("A145").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("R" & .Cells(.Rows.Count, "R").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("A158").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("S" & .Cells(.Rows.Count, "S").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
With ActiveSheet
    .Range("C169").Copy
  End With
  With ThisWorkbook
    With .Sheets("Compile")
      .Range("T" & .Cells(.Rows.Count, "T").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
  Application.DisplayAlerts = False
  ActiveWorkbook.Close
  NomFichier = Dir  'va vers le fichier suivant à importer

Loop  'recommece la boucle avec le fichier suivant
End Sub