Help : macro de copie de données et de regroupement d'informations

jesuisperdubzh

XLDnaute Nouveau
Bonjour à tous,
Je suis novice en macro et j'aurai besoin de l'aide de quelqu'un :
J'ai joint un fichier exemple qui permettra d'illustrer mon propos.
Je souhaiterais faire en sorte dans mon exemple que mon dernier onglet annuel fasse une synthèse des précédents (mensuels), que les données des personnes se mettent bien en face de la personne en sachant qu'elles seront triées par ordre alphabétique et qu'en cours d'année des salariés peuvent être embauchés (c'est un fichier pour le décompte des heures).
Voila, merci d'avance à l'âme charitable qui acceptera de m'aider (ne pas hésiter à toucher au document je n'ai rien protégé exprès).
Merci d'avance, je reste ouvert si quelqu'un veut des précisions.

Bonne journée
Clément
 

Fichiers joints

Robert

XLDnaute Barbatruc
Re : Help : macro de copie de données et de regroupement d'informations

Bonjour tépaumé, bonjour le forum,

Peut-être comme ça :

Code:
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim RC As Worksheet 'déclare la variable RC (onglet RéCap)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set RC = Sheets("Récap") 'définit l'onglet RC
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    Select Case O.Name 'agit en fontion du nom de l'onglet
        Case "Janvier"
            COL = 3 'définit la colonne COL
        Case "Février"
            COL = 15 'définit la colonne COL
        Case "Mars"
            COL = 27 'définit la colonne COL
        Case "Avril"
            COL = 39 'définit la colonne COL
        Case "Mai"
            COL = 51 'définit la colonne COL
        Case "Juin"
            COL = 63 'définit la colonne COL
        Case "Juillet"
            COL = 75 'définit la colonne COL
        Case "Août" 'attention j'ai renommé lónglet avec l'accent (û)
            COL = 87 'définit la colonne COL
        Case "Septembre"
            COL = 99 'définit la colonne COL
        Case "Octobre"
            COL = 11 'définit la colonne COL
        Case "Novembre"
            COL = 123 'définit la colonne COL
        Case "Décembre"
            COL = 135 'définit la colonne COL
        Case "Recap"
            GoTo suite 'va à l'étiquette "suite"
    End Select 'fin de l'action en fonction du non de l'onglet
    TV = O.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes du tableau des valeurs (en partant de la seconde)
        Set R = RC.Columns("A").Find(TV(I, 1), , xlValues, xlWhole) 'définit la recherche R (Recherche dans la colonne A de Récap la valeur entière de TV(I,1))
        If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
            LI = R.Row 'définit la ligne LI (ligne de la première occurrence trouvée)
        Else 'sinon
            LI = RC.Range("A" & Application.Rows.Count).End(xlUp).Row + 1 'définit la ligne LI (première ligne vide de la colonne A de Récap)
        End If 'fin de la condition
        RC.Cells(LI, 1).Value = TV(I, 1) 'place le nom dans la colonne A de Récap
        RC.Cells(LI, 2).Value = TV(I, 2) 'place le prénom dans la colonne A de Récap
        For J = 0 To 10 'boucle 3 : de 0 à 10
            RC.Cells(LI, COL + J).Value = TV(I, J + 3) 'renvoie la donnée du tableau TV dans la colonne COL + J de Récap
        Next J 'prochaine colonne de la boucle 3
    Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
Next O 'prochain onglet de la boucle 1
End Sub
 

jesuisperdubzh

XLDnaute Nouveau
Re : Help : macro de copie de données et de regroupement d'informations

Bonjour Robert,
Merci pour ta réponse,
Alors j'ai testé ta macro, elle fonctionne... partiellement, en effet certaine donnée s'affiche correctement, mais d'autres affiche des réponses incohérentes ou rien du tout alors qu'il devrait y'avoir des informations mentionnées...
Par contre c'est vrai que rien que le principe des noms qui s'affichent tous ça m'aide énormément, maintenant si les données pouvaient être les bonnes ce serai encore mieux ^^^
A la rigueur si tu ne trouves pas de solution ce que je ferai c'est que je garderai la partie de ta macro qui fais le tri des noms tout en recherchant les données par de la recherche v !
Il faudrait aussi que les noms se classent par ordre alphabétique (très important) et donc par conséquent que les données suivent les noms (attention car sur certains mois der personnes peuvent être embauchés ou à l'inverse sortir des effectifs).
Dans tout les cas encore une fois merci beaucoup !
Clément
 

Robert

XLDnaute Barbatruc
Re : Help : macro de copie de données et de regroupement d'informations

Re,

Oui il y avait une erreur pour le mois d'octobre où j'avais écrit COL = 11 au lieu de COL = 111. Ça décalait tout...
Pour le reste je regarderai plus tard...

 

jesuisperdubzh

XLDnaute Nouveau
Re : Help : macro de copie de données et de regroupement d'informations

Oui je m'en suis aperçu et j'ai corriger ^^
je te remercie, je te met la dernière version du fichier de départ !
Par contre c'est curieux mais pour deux salariés les données d'octobre apparaisse aussi en février et décembre !
Je ne comprends pas d'où ça provient (Beirou et Chjirac) ! Je vais continuer à chercher !
Merci de ton aide précieuse ;)
 

Papou-net

XLDnaute Barbatruc
Re : Help : macro de copie de données et de regroupement d'informations

Bonjour jesuisperdubzh, et bienvenue sur XLD,
Bonjour Robert, et bon maintien sur XLD,

Malgré ma pause déjeuner et puisque je l'ai fait (et d'une manière différente), je joins le résultat de mes élucubrations vébéastiques.

A +

Cordialement.
 

Fichiers joints

jp14

XLDnaute Barbatruc
Re : Help : macro de copie de données et de regroupement d'informations

Bonjour à tous

Ci dessous un code à tester
Le pas est à modifier si on rajoute des colonnes
Si le nom n'existe pas il est crée dans la feuille récap.
Le total annuel n'est pas traité, il peut se faire par formule.
Attention au nom et prénom identiques.

Code:
' classeur
Dim Shd As Worksheet, ShR As Worksheet
Dim MonTab As Variant, Compt1 As Long

Sub copyData()
Dim Pas As Integer
Pas = 12 ' a modifier
Set ShR = Worksheets("Récap")

For Each Shd In Worksheets
    Select Case Shd.Name
        Case "Janvier"
            MoisNom Shd, 3
        Case "Février"
            MoisNom Shd, (3 + Pas)
        Case "Mars"
            MoisNom Shd, (3 + 2 * Pas)
        Case "Avril"
            MoisNom Shd, (3 + 3 * Pas)
        Case "Mai"
            MoisNom Shd, (3 + 4 * Pas)
        Case "Juin"
            MoisNom Shd, (3 + 5 * Pas)
        Case "Juillet"
            MoisNom Shd, (3 + 6 * Pas)
        Case "Aout"
            MoisNom Shd, (3 + 7 * Pas)
        Case "Septembre"
            MoisNom Shd, (3 + 8 * Pas)
        Case "Octobre"
            MoisNom Shd, (3 + 9 * Pas)
        Case "Novembre"
            MoisNom Shd, (3 + 10 * Pas)
        Case "Décembre"
            MoisNom Shd, (3 + 11 * Pas)
    End Select
Next Shd
End Sub


Private Function RechercheLigne(Nom As String, Prenom As String) As Long
RechercheLigne = 0
With ShR
Set Plg1 = .Range("A1:B" & .Range("a" & .Rows.Count).End(xlUp).Row)
MonTab = Plg1.Value
For Compt1 = LBound(MonTab, 1) To UBound(MonTab, 1)
    If MonTab(Compt1, 1) = Nom And MonTab(Compt1, 2) = Prenom Then
         RechercheLigne = Compt1
         Exit Function
    End If
Next Compt1
End With
End Function

Private Sub MoisNom(Shd As Worksheet, Colonne As Long)
Dim Cellule1 As Range, Plg1 As Range, Lig As Long
With Shd
    
For Each Cellule1 In .Range("a2:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
    Lig = RechercheLigne(CStr(Cellule1.Value), CStr(Cellule1.Offset(0, 1).Value))
   If Lig = 0 Then 'ajout
        Dl1 = ShR.Range("A" & Rows.Count).End(xlUp).Row + 1
        ShR.Range("a" & Dl1) = Cellule1
        ShR.Range("b" & Dl1) = Cellule1.Offset(0, 1)
        Lig = Dl1
        .Range(Cellule1.Offset(0, 2).Address(0, 0) & ":M" & Cellule1.Row).copy _
        Destination:=ShR.Cells(Lig, Colonne)
   Else
   .Range(Cellule1.Offset(0, 2).Address(0, 0) & ":M" & Cellule1.Row).copy _
   Destination:=ShR.Cells(Lig, Colonne)
   End If
Next Cellule1
End With
End Sub
 
Dernière édition:

jesuisperdubzh

XLDnaute Nouveau
Re : Help : macro de copie de données et de regroupement d'informations

Merci à tous pour vos macros toutes plus efficaces les unes que les autres :)
Ca marche nickel ! Je n'ai plus qu'a l'adaptée sur le vrai fichier !
Encore merci d'avoir prit sur votre temps et bonne continuation !
 

jesuisperdubzh

XLDnaute Nouveau
Re : Help : macro de copie de données et de regroupement d'informations

Bonjour à tous, en utilisant vos différentes macro, je me suis rendu compte d'un petit inconvénient m'empêchant d'avancer sur mon programme : le bilan en page "Récap" ne prend pas en compte les salariés ayant le même nom de famille.
Par exemple si j'ai :
- MARTIN Jean
- MARTIN Richard
et bien Richard n'apparaîtra pas dans le récap !
Etant dans une structure locale et conviviale, nous avons plusieurs salariés issu de même famille et portant donc le même nom, cela est donc embêtant de les voir disparaître de la base de calcul des heures ^^
Voila, si quelqu'un a une solution sur sa macro de départ ce serai super cool !
Merci d'avance et bonne journée !
Clément
 

Papou-net

XLDnaute Barbatruc
Re : Help : macro de copie de données et de regroupement d'informations

Bonjour Clément,

Voici une nouvelle copie de ton fichier adapté à la nouvelle exigence.

A +

Cordialement.
 

Fichiers joints

jp14

XLDnaute Barbatruc
Re : Help : macro de copie de données et de regroupement d'informations

Bonjour

La procédure ci dessus accepte les noms identiques mais pas les noms et prénoms rigoureusement identiques, seul le premier dans la liste sera pris en compte.
Code:
If MonTab(Compt1, 1) = Nom And MonTab(Compt1, 2) = Prenom Then
JP
 

jesuisperdubzh

XLDnaute Nouveau
Re : Help : macro de copie de données et de regroupement d'informations

Bonjour messieurs !
Un grand bravo accompagné d'un encore plus grand merci !
Cela fonctionne maintenant à la perfection :)
Bonne journée
Clément
 

Discussions similaires


Haut Bas