Passage d'information d'un Excel a une autre

Question

Bonjour tout le monde !

Je suis novice dans le fabuleux univers du VBA, et on m'a confié une tâche pour laquelle je manque d'expérience.

Mes collaborateurs me fournissent des rapports d'intervention de leur différente activité. Ces fichiers sont construits de la même façon. Je dois regrouper les informations qu'ils contiennent dans un fichier Résume. Ce qui m'intéresse, c'est seulement de récupérer le contenu des différentes cellules, sans s'occuper des formules, j'ai juste besoin du texte, date et heure.

Les fichiers seront nommés différemment (en fonction de la date) à chaque fois, mais seront placés dans le même dossier.

Le nombre de rapports varie selon les semaines.

Le macro doit être capable d'aller chercher tout fichier Excel présent dans un dossier donné, récupérer toutes les infos des cellules.

Les cellules en vert dans le rapport d'intervention sont celle qui doive se reporte sur l'Excel résume d’intervention.

Ma demande, est-elle claire ?

Merci mille fois d'avance pour vos réponses !

8rapport-d-intervention.xlsx (9.36 Ko)

6resume-d-intervention.xlsx (9.46 Ko)

ThauThème · Accepted Answer

Bonjour Adri et bienvenu, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim LR As Integer 'déclare la variable LR (Ligne de Référence)
Dim F As String 'déclare la variable F (Fichier)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destinatiion OD (le premeir onglet de CD)
CA = CD.Path & "\" 'définit le chen=min d'accès CA
OD.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelle anciennes données de l'onglet OD (ligne a supprimer si tu désires les garder)
F = Dir(CA & "*.xlsx") 'définit le premier fichier F ayant CA comme chemin d'accès
Do While F <> "" 'tant qu'il existe des fichiers F avec l'extension .xls dans le dossier ayant CA comme chemin d'accès
    Set CS = Workbooks.Open(CA & F) 'définit le classeur source (en l'ouvrant)
    Set OS = CS.Worksheets(1) 'définit l'onglet source (le premier onglet de CS)
    LR = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la ligne de référence LR
    OD.Cells(LR, 1).Value = OS.Range("A11").Value 'récupère la date
    OD.Cells(LR, 2).Value = OS.Range("A4").Value 'récupère le numéro du client
    OD.Cells(LR, 3).Value = OS.Range("A6").Value 'récupère le numéro du rapport
    OD.Cells(LR, 4).Value = OS.Range("D11").Value 'récupere le total d'eure
    OD.Cells(LR, 4).NumberFormat = "h:mm" 'format du total d'heures
    OD.Cells(LR, 5).Value = OS.Range("A21").Value 'récupère le nom du client
    CS.Close False 'ferme le classeur source sans enregsitrer
    F = Dir 'définit le prochain fichier F
Loop 'boucle
End Sub

Ton fichier qui devient xlsm puisqu'il contient désormais la macro ci-dessus :

7resume-d-intervention.xlsm (19.45 Ko)