XL 2016 Afficher les résultats d'un tableau dans un autre

[Bobleesouf]

Salut!
Ce que je cherche exactement c'est afficher la dernière résultats de chaque PR pour chaque agents ?
et s'il est possible afficher la date dans chaque cellules (option non obligatoire).
et merci d'avance.

Dans un forum ils m'ont donnés ce code, mais je veux l'adapter si les tableaux des agents ne se trouvent pas sur le même ficher :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim PL(1 To 3) As Range 'déclare le tableau de 3 variables (PLages)
Dim PLR As Range 'déclare la variable PLR (PLage des Résultats)
Dim A As Byte 'déclare la variable A (Agent)
Dim PR As Byte 'déclare la variable PR
Dim COL As Integer 'déclare la variable COL (COLonne)

Set O = Worksheets("Feuil2") 'définit l'onglet O
Set PL(1) = O.Range("B3:F8") 'définit la plage PL(1)
Set PL(2) = PL(1).Offset(0, 7) 'définit la plage PL(2)
Set PL(3) = PL(2).Offset(0, 7) 'définit la plage PL(3)
Set PLR = O.Range("B14:F16") 'définit la plage PLR
For A = 1 To 3 'boucle 1 : sur les 3 lignes des agents
For PR = 1 To 5 'boucle 2 : sur les 5 lignes des PR
For COL = 5 To 1 Step -1 'boucle inversée 3 : sur les 5 colonnes des dates en partant de la dernière
If PL(A).Cells(PR + 1, COL).Value <> "" Then 'condition : si la valeur de la cellule en ligne PR, colonne COL de la plage PL(A) n'est pas vide
PLR(A, PR) = PL(A).Cells(1, COL) 'renvoie dans la cellule ligne A colonne PR de la plage PLR la date correspondante
PLR(A, PR).Interior.Color = PL(A).Cells(PR + 1, COL).DisplayFormat.Interior.Color 'récupère la couleur de la MFC
PLR(A, PR).NumberFormat = "dd/mm/yyyy" 'formate la date
Exit For 'sort de la boucle 3
End If 'fin de la condition
Next COL 'prochaine colonne de la boucle 3
Next PR 'prochaine ligne de la boucle 2
Next A 'prochaine ligne de la boucle 3
End Sub

Ce code ça marche bien pour mon 1er exemple (Les tableaux se trouvant sur la même feuille), maintenant je veux l'adapter pour le cas (Les tableaux des PR de agents sont séparés)

Merçi d'avance

 

[sylvanu]

Bonjour Bobleesouf,
Un exemple de copie paste de données d'autres fichiers :

Sub CopyAgent()
' ouverture fichier agent
    Set wk1 = Workbooks.Open("C:\Users\PC_PAPA\Desktop\agent 1.xlsx")   ' A adapter
    Set wk2 = Workbooks.Open("C:\Users\PC_PAPA\Desktop\agent 2.xlsx")   ' A adapter
    Set wk3 = Workbooks.Open("C:\Users\PC_PAPA\Desktop\agent 3.xlsx")   ' A adapter
' copie des données
    wk1.Sheets("Feuil1").Range("A1:F8").Copy ThisWorkbook.Sheets("RecapAgent").Range("A1")
    wk2.Sheets("Feuil1").Range("A1:F8").Copy ThisWorkbook.Sheets("RecapAgent").Range("H1")
    wk3.Sheets("Feuil1").Range("A1:F8").Copy ThisWorkbook.Sheets("RecapAgent").Range("O1")
' fermeture des fichiers agent
    wk1.Close
    wk2.Close
    wk3.Close
End Sub

Ne fait que copier, ne calcule pas la matrice A13:F16.

Par contre si vous avez beaucoup d'agents il faut utiliser une fonction pour être plus simple à écrire.
C'est le cas ?

 

[sylvanu]

Dans le cas où vous auriez beaucoup d'agent :

Sub CopieToutAgent()
Dim Liste()
' Déclaration de la racine du fichier, doit se terminer par \
    Racine = "C:\Users\PC_PAPA\Desktop\"                    ' A adapter
' Declaration des noms de fichiers
    ListeFichiers = Array("agent 1.xlsx", "agent 2.xlsx")   ' Rajouter tous les agents
' Nombre de fichiers déclarés
    Taille = UBound(ListeFichiers)
' Lancement écriture données
    For NoFichier = 0 To Taille
        Ligne = 9 * NoFichier + 1                                       ' Calcule le NO de ligne où coller
        Set wk = Workbooks.Open(Racine & ListeFichiers(NoFichier))      ' Construit le chemin d'accés
        wk.Sheets("Feuil1").Range("A1:F8").Copy ThisWorkbook.Sheets("RecapAgent").Range("A" & Ligne)    ' Colle données
        wk.Close     ' Ferme le fichier
    Next NoFichier
End Sub

J'ai mis les agents en verticale. Pour les avoir en horizontal modifier le calcul de Ligne en Colonne.
Mais avec plein d'agents je pense que c'est plus lisible de les avoir en verticale. A vous de voir.

 

[Bobleesouf]

Bonjour sylvanu,
Je pense que tu n'as pas bien compris mon message, le code que j'ai posé ça marche bien dans ce cas (voir PJ "exemple plan veille2.xlsm") où les tableau ce trouve dans la même feuille, (le tableau "A13:F16" prend la couleur + la date de chaque PR pour chaque agents, après tu appui sur "Actualiser" pour exécuter le Macro.
Maintenant je veux déplacer les tableaux des agents vers des fichiers séparés (chaque agent avec son fichier) et garder la même fonction sans ouvrir par exemple tous les fichiers.
et merci

 

[sylvanu]

Sorry. C'était pas clair.

Les tableaux des PR de agents sont séparés

pouvait signifier que les fichiers agents étaient déjà séparés.
( évitez la mise en gras )

 

[Bobleesouf]

Non, j'ai juste déplacer les tableaux de chaque agents vers les fichier "agant 1.xlsx ..."

 

[sylvanu]

Alors, désolé, c'est pas clair.
Si vous avez dejà déplacé les agents dans des fichiers agent 1.xlsx, agent 2.xlsx .....
Alors ma macro fonctionne puisqu'elle récupère les données de chaque fichier pour compiler dans une seule feuille.

 

[Bobleesouf]

Votre macro ouvre les fichiers des agents et il block Excel :/

 

[sylvanu]

Vous avez mise à jour la macro ? Ce n'est pas du tout cuit. Il faut lui dire quoi faire.
En particulier modifier la racine ainsi que la liste des fichiers.

Dim Liste()
' Déclaration de la racine du fichier, doit se terminer par \
    Racine = "C:\Users\PC_PAPA\Desktop\"                    ' A adapter
' Declaration des noms de fichiers
    ListeFichiers = Array("agent 1.xlsx", "agent 2.xlsx")   ' Rajouter tous les agents

Je l'ai testée sur 3 agents, et ça marche correctement.
XL donne une erreur sur quelle ligne ?

 

[Bobleesouf]

Est ce qu'il faut modifier d'autre choses la ?

Voilà le message d'erreur :

 

[sylvanu]

Ci joint un dossier avec trois agents. Il suffit de modifier la ligne
Racine = "C:\Users\PC_PAPA\Desktop\Dossier\" avec votre emplacement.
Je l'ai testé, retesté et ça marche.
Pouvez vous tester en gardant le même dossier et les même fichiers ?

 

[Bobleesouf]

Ca marche bien mais je veux grouper les résultats dans un seul tableau comme j'ai expliquer dans l'exemple (voir PJ "exemple plan veille2.xlsm")

 

[sylvanu]

Vous pourriez au moins expliquer ce qui n'aller pas dans votre version ?
Je vous fait une version horizontale.
( évitez la mise en gras )

 

[Bobleesouf]

Vous avez compris ce que je veux exactement ?

 

[sylvanu]

En PJ importation horizontale avec 4 fichiers agents.