VBA EXL - Synthèse de plusieurs fichiers avec commentaire dans un seul

Version imprimable

29/01/2019, 11h25
SyPi00

VBA EXL - Synthèse de plusieurs fichiers avec commentaire dans un seul

Bonjour,

Je galère un peu sur ma macro Excel alors je fais un appel à l'aide!:calim2:

J'ai une équipe de 1 à 10 agents qui travaillent pour chacun des pays respectifs (c'est du détail mais c'est plus simple à comprendre). Tous les trimestres je sors un fichier d'un outil qui liste de données par pays. Je leur ai demandé de travailler chacun sur une version de ce fichier en mettant des commentaires, statuts... en face des lignes correspondant à leurs lignes pays.

Donc ce que je voudrais en résultat avoir un fichier de consolidation de l'ensemble de leurs commentaires => donc si j'ai sorti 1000 lignes de données (par ex), je dois garder ces 1000 lignes mais avec le commentaire de chacun en bout de ligne.
Ex :
Lign1 Pays1 Donnée1
Lign2 Pays2 Donnée2
Lign3 Pays1 Donnée3

Agent1 fait :
Lign1 Pays1 Donnée1 OK
Lign2 Pays2 Donnée2
Lign3 Pays1 Donnée3 KO Com2

Agent2 fait :
Lign1 Pays1 Donnée1
Lign2 Pays2 Donnée2 OK Com3
Lign3 Pays1 Donnée3

En résultat je souhaite :
Lign1 Pays1 Donnée1 OK
Lign2 Pays2 Donnée2 OK Com3
Lign3 Pays1 Donnée3 KO Com2

Ce que j'entrevois comme solution :
1. Regrouper tous les fichiers dans un seul (un onglet par agent) => ok c'est bon j'ai fait
2. Sur un onglet avec mes 1000 lignes, faire tourner une macro pour récupérer : concaténer les mêmes cellules (J1 de la feuille UT1, J1 de la feuille UT2,...). Cela me permet de voir les incohérences s'il y a.

Contrainte : je n'ai pas toujours le même nombre d'agents à chaque période, aussi j'aimerai utiliser un onglet avec la liste du nom des feuilles récupérées (je mettrais en paramétrage).

Quelqu'un à une idée pour faire ça??
Jusqu'ici je ne vois que concaténer avec le nom de la feuille en dur ou avec un indirect mais ca ne résout pas mon problème du nombre de feuille/agents variable...

J'espère que qqn pourra m'aider ...:(

Merciiii par avance!!

1 pièce(s) jointe(s)

Bonjour à toutes et à tous
la structure des données d'entrée n'est pas claire au moins pour moi ... pour regrouper dans une feuille récap voila une piste à adapter à tes besoins

Bonne continuation

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
Sub collecterDonnées()
Application.ScreenUpdating = False
Dim derligne As Long
Dim k As Long
Dim j As Long
Dim i As Long
Dim P As Long
Dim H As Long
j = 2
With Sheets("RECAPITULATIF")
derligne = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A2:D" & derligne).ClearContents
 
 For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "RECAPITULATIF" Then
        k = Worksheets(i).Range("A" & Rows.Count).End(xlUp).Row
        Worksheets(i).Range("A2:C" & k).Copy .Range("A" & j)
        P = (j + k - 2)
         For H = j To P
        .Range("D" & H) = Worksheets(i).Name
        Next H
        j = .Range("A" & Rows.Count).End(xlUp).Row + 1
        End If
    Next i
End With
MsgBox "regroupement effectué"
Application.ScreenUpdating = True
End Sub

29/01/2019, 14h17
SyPi00

Merci. Mais ce n'est pas ce que je souhaite (ou alors je ne vois pas comment je pourrais le réadapter)

Si je prends un exemple:

Onglet "Agent1" : a rempli la ligne 1 et 3
Lig1 Suisse StatutOK Commentaire1
Lig2 Allemagne
Lig3 France StatutKO Commentaire3
Lig4 Pays Bas

Onglet "Agent2" : a rempli la ligne 2
Lig1 Suisse
Lig2 Allemagne StatutOK Commentaire2
Lig3 France
Lig4 Pays Bas

Ton code me donne plusieurs fois le bloc à la suite :
Lig1 Suisse StatutOK Commentaire1 Agent1
Lig2 Allemagne Agent1
Lig3 France StatutKO Commentaire3 Agent1
Lig4 Pays Bas Agent1
Lig5 Suisse Agent2
Lig6 Allemagne StatutOK Commentaire2 Agent2
Lig7 France Agent2
Lig8 Pays Bas Agent2

Moi ce que je voudrais c'est :
Lig1 Suisse StatutOK Commentaire1 Agent1
Lig2 Allemagne StatutOK Commentaire2 Agent2
Lig3 France StatutKO Commentaire3 Agent1
Lig4 Pays Bas

Sans ligne supplémentaire, tout sur le même bloc.

Est ce que c'est possible?
29/01/2019, 14h24
BENNASR

peux tu joindre un petit fichier sans macro avec un exemple de quelques lignes pour gagner du temps

si tu veux regrouper que si le statut en colonne B est différent de vide essayez avec les filtres :
peut être comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Option Explicit
Sub collecterDonnées()
Application.ScreenUpdating = False
Dim derligne As Long
Dim k As Long
Dim j As Long
Dim i As Long
Dim H As Long
Dim L As Long
j = 2
With Sheets("RECAPITULATIF")
 .Cells.ClearContents
 
.Cells(1, 1).Resize(1, 4) = Array("PAYS", "STATUT", "Commentaire", "employé")
 
 For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "RECAPITULATIF" Then
        k = Worksheets(i).Range("A" & Rows.Count).End(xlUp).Row
        Worksheets(i).Range("A1:C" & k).AutoFilter Field:=2, Criteria1:="<>"
        Worksheets(i).Range("A2:C" & k).SpecialCells(xlCellTypeVisible).Copy .Range("A" & j)
        derligne = .Range("A" & Rows.Count).End(xlUp).Row
        For H = j To derligne
        .Range("D" & H) = Worksheets(i).Name
        j = derligne + 1
        Next H
        Worksheets(i).ShowAllData
        End If
    Next i
End With
MsgBox "regroupement effectué"
Application.ScreenUpdating = True
End Sub

29/01/2019, 15h56
SyPi00

1 pièce(s) jointe(s)

Voici un exemple de données avec le résultat souhaité sur le dernier onglet (avec la formule que j'ai en tête mais il y a peu être mieux comme solution)!

Merci pour ton aide!!

1 pièce(s) jointe(s)

à tester

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Explicit
Sub collecterDonnées()
Application.ScreenUpdating = False
Dim derligne As Long
Dim k As Long
Dim j As Long
Dim i As Long
Dim H As Long
Dim L As Long
j = 3
With Sheets("RECAPITULATIF")
 .Cells.ClearContents
 
.Cells(2, 1).Resize(1, 6) = Array("Pays", "Montant Valeur", "Agent en charge", "Statut", "Commentaire")
 
 
 For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "RECAPITULATIF" And Worksheets(i).Name <> "Param agent" And Worksheets(i).Name <> "Résultat souhaité apres Macro" Then
        k = Worksheets(i).Range("A" & Rows.Count).End(xlUp).Row
        Worksheets(i).Range("A2:F" & k).AutoFilter Field:=4, Criteria1:="<>"
        Worksheets(i).Range("A3:F" & k).SpecialCells(xlCellTypeVisible).Copy .Range("A" & j)
        derligne = .Range("A" & Rows.Count).End(xlUp).Row
        j = derligne + 1
        Worksheets(i).ShowAllData
        End If
    Next i
End With
MsgBox "regroupement effectué"
Application.ScreenUpdating = True
End Sub

30/01/2019, 15h33
SyPi00

Merci.

C'est presque ça. Est ce qu'il est possible d'avoir le même ordre de ligne que le fichier original (parce que le fichier doit encore être retravaillé après)? Je ne vois pas comment faire...

Pourrais tu m'expliquer les grandes lignes de ton code stp, j'ai pas compris comment il faisait.:P
31/01/2019, 11h57
SyPi00

1 pièce(s) jointe(s)

Voici un exemple de ce que je voudrais avec une des lignes non traitées par l'agent (le commentaire c'est plus pour expliquer) : identifier les lignes qu'aucune personne n'a traité pour que je puisse l'attribuer à un agent pour analyse.

De plus, j'aimerai garder le même ordre de ligne qu'à l'origine : pas classé par ordre alphabétique de pays, ni par nom d'agent. Juste à l'identique de l'extraction d'origine. Ca serait top (le plus important étant de voir mes lignes vides...)!

Merci!
31/01/2019, 13h12
BENNASR

1 pièce(s) jointe(s)

du bricolage à tester :aie:
31/01/2019, 16h15
BENNASR

1 pièce(s) jointe(s)

à TESTER
31/01/2019, 23h33
SyPi00

Hello

Merci pas loin. Par contre dans l'exemple,je me retrouve avec en France :le nom de Paul et le commentaire de Céline (pareil pour l'Inde où Pierre se retrouve avec le commentaire de Céline). Il serait plus cohérent de mettre le commentaire de Paul avec son nom et Céline comme autre agent (pareil pour Pierre).

Tu m'expliques ton code rapidement stp :) c'est magique!
01/02/2019, 08h44
BENNASR

1 pièce(s) jointe(s)

Bonjour
code commenté dans la feuille jointe
si c'est résolu merci de cliquer en bas sur le bouton approprié
BONNE JOURNÉE
01/02/2019, 16h02
SyPi00

Ca marche!

Un grand Merci pour ton aide. C'est toute une équipe que tu viens de dépanner. :)