copie ligne VBA

[loisphil81]

Bonjour forum,

néophyte en VBA ? J'aurai besoin d'un petit coup de main pour mon fichier
dans ce fichier j'ai crée 2 bouton sur la feuil "Compteurs" 2 horaires différents qui me permettrai en cliquant dessus de copier la dernière ligne de chaque tableau dans chacun des tableaux de la feuil "Recap" correspondant aux horaires avec incrémentation pour chaque journées.
je ne sais pas si je suis très claire mais je vous fais confiance.
un grand merci pour votre aide
Phil

 

[Matheop]

Hello loisphil81, le forum.

Je te propose le code ci-dessous à insérer dans tes macros événementielles de type « CommandButton_Click() ». De ce que je comprends tu as deux boutons, un pour la matin et un pour l'après-midi ; tu devrais déjà les renommer pour éviter toute confusion. Le code proposé est fait uniquement pour la plage horaire du matin, il suffit juste de l'adapter pour l'après-midi (seuls les colonnes, plages utilisées vont changer).

Sub ajout_recapMatin()
    ' définition de la plage recap du matin
    Dim ligneRecap
    Set ligneRecap = Sheets("COMPTEURS").Range("B60:G60")
 
    ' arrêt si manque d'infos dans la plage recap
    If WorksheetFunction.CountBlank(ligneRecap) Then
        MsgBox ("Il manque des infos dans la ligne récapitulative.")
    ' sinon on continue
    Else
        ' récupération de la dernière ligne non vide des colonnes A et B de la feuille Recap (donc pour le matin)
        Dim nextLigne As Integer
        Dim nbMaxLignes As Integer
        Dim trig As Integer
        nbMaxLignes = Sheets("Recap").Range("A1048576").End(xlUp).Row
        nextLigne = Sheets("Recap").Range("B1048576").End(xlUp).Row
        trig = 1
     
        ' si pas de valeur en colonne A (c'est qu'on est dimanche) on passe à la ligne suivante où il y a une date
        If IsEmpty(Sheets("Recap").Cells(nextLigne + 1, 1)) Then
            nextLigne = nextLigne + 1
        End If
     
        ' copie depuis COMPTEURS > Recap uniquement s'il y a une date
        ' on ne copie plus si les recaps ajoutés (colonnes B<->G) dépassent les dates (colonne A)
        If nextLigne < nbMaxLignes Then
            For Each cel In ligneRecap.Cells
                Sheets("Recap").Cells(nextLigne + 1, 1).offSet(0, trig).Value = cel.Value
                trig = trig + 1
            Next cel
        End If
    End If
End Sub

C'est un code assez simple et imparfait qui répond en partie au besoin.

Dans la macro à faire pour la plage horaire 13/20h, il suffit de changer la plage de ligneRecap (J60:O60) et le nextLigne (pour mettre K1048576 au lieu de B1048576).

Cela part bien évidemment du principe que l'effectif est fixe ; si tu veux ajouter/supprimer un membre de l'effectif il faudra manuellement modifier les plages bien que le top serait de déterminer dynamiquement le nombre de membres dans l'effectif.

Il faut appuyer sur les boutons une fois par jour sinon tu vas remplir les journées suivantes, etc.

C'est un code fonctionnel mais simple. Il est bien évidemment à approfondir pour faire un truc plus poussé.

A bientôt,

 

[loisphil81]

bonjour forum
merci MatiChøux
pour ta proposition entre temps j'ai pu être aidé sur un autre forum.

je te propose un nouveau challenge si ca te dit avec le fichier joint
comme ca tu pourra voir le code qui ma été fourni (haut de gamme)

Dans la feuille "Stats Compteurs individuels" je souhaiterai copier uniquement les valeurs (les valeurs vont changer tous les jours)du tableau Quantitatif journées individuel dans le grand tableau Histo compteur individuel en les incrémentants pour chaque journée

cdt
phil

 

[Matheop]

Hello again,

Je dirais un code dans ce style alors :

Sub report()
    ' récupération dernier membre effectif
    Dim nbEffectif As Integer
    nbEffectif = Sheets(4).Range("A1048576").End(xlUp).Row
    ' récupération dernire colonne Histo compteur individuel
    Dim nbColonnes As Integer
    nbColonnes = Sheets(4).Range("XFD3").End(xlToLeft).Column
    ' récupération derniere date (colonne F)
    Dim nbDates As Integer
    nbDates = Sheets(4).Range("F1048576").End(xlUp).Row

    Dim plageHistoCompteur As Range
    Dim plageDates As Range
    ' plage histo compteur individuel : G3 à CX3 dans le cas present
    ' ('nbColonnes + 4' car un nom correspond à 4 cellules fusionnees RDV/GRIP/OK/KO)
    Set plageHistoCompteur = Sheets(4).Range(Cells(3, 7), Cells(3, nbColonnes + 4))
    ' plage des dates : F5 à F28 dans le cas present
    Set plageDates = Sheets(4).Range("F5:F" & nbDates)
    Dim celNom As Range
    Dim nom As String
    Dim celDate As Range
    Dim trig As Integer
  
    ' boucle sur chaque membre effectif
    For x = 5 To nbEffectif
        trig = 0
        ' verification date correspond à la date du jour sinon on fait rien
        For Each celDate In plageDates
            If celDate.Value = Date Then
                ' si on est ici c'est qu'on est dans la ligne de la date du jour
                ' on cherche dans la plage du histo compteur la cellule qui correspond au nom du membre
                ' exemple : on cherche la valeur de A5 on la trouve dans G3, on chercher la valeur de A6 on la trouve dans K3
                nom = Sheets(4).Cells(x, 1).Value
                Set celNom = plageHistoCompteur.Find(nom)
                ' on copie dans la cellule à l'intersection :
                ' - de la ligne de la date du jour
                ' - de la colonne de la cellule (où on a trouvé le nom) en modulo 3 puisqu'un nom est écrit sur 4 cellules
                ' la valeur de la cellule en Bx, Cx, Dx, Ex...
                For trig = 0 To 3 Step 1
                    Sheets(4).Cells(celDate.Row, celNom.Column + trig).Value = Sheets(4).Cells(x, trig + 2).Value
                Next trig
            End If
        Next celDate
    Next x
End Sub

J'ai essayé de bien commenter pour que ce soit compréhensible.
A toi de me dire si ça convient ou pas.

A bientôt,

 

[loisphil81]

Hello again,

Je dirais un code dans ce style alors :

Sub report()
    ' récupération dernier membre effectif
    Dim nbEffectif As Integer
    nbEffectif = Sheets(4).Range("A1048576").End(xlUp).Row
    ' récupération dernire colonne Histo compteur individuel
    Dim nbColonnes As Integer
    nbColonnes = Sheets(4).Range("XFD3").End(xlToLeft).Column
    ' récupération derniere date (colonne F)
    Dim nbDates As Integer
    nbDates = Sheets(4).Range("F1048576").End(xlUp).Row

    Dim plageHistoCompteur As Range
    Dim plageDates As Range
    ' plage histo compteur individuel : G3 à CX3 dans le cas present
    ' ('nbColonnes + 4' car un nom correspond à 4 cellules fusionnees RDV/GRIP/OK/KO)
    Set plageHistoCompteur = Sheets(4).Range(Cells(3, 7), Cells(3, nbColonnes + 4))
    ' plage des dates : F5 à F28 dans le cas present
    Set plageDates = Sheets(4).Range("F5:F" & nbDates)
    Dim celNom As Range
    Dim nom As String
    Dim celDate As Range
    Dim trig As Integer
 
    ' boucle sur chaque membre effectif
    For x = 5 To nbEffectif
        trig = 0
        ' verification date correspond à la date du jour sinon on fait rien
        For Each celDate In plageDates
            If celDate.Value = Date Then
                ' si on est ici c'est qu'on est dans la ligne de la date du jour
                ' on cherche dans la plage du histo compteur la cellule qui correspond au nom du membre
                ' exemple : on cherche la valeur de A5 on la trouve dans G3, on chercher la valeur de A6 on la trouve dans K3
                nom = Sheets(4).Cells(x, 1).Value
                Set celNom = plageHistoCompteur.Find(nom)
                ' on copie dans la cellule à l'intersection :
                ' - de la ligne de la date du jour
                ' - de la colonne de la cellule (où on a trouvé le nom) en modulo 3 puisqu'un nom est écrit sur 4 cellules
                ' la valeur de la cellule en Bx, Cx, Dx, Ex...
                For trig = 0 To 3 Step 1
                    Sheets(4).Cells(celDate.Row, celNom.Column + trig).Value = Sheets(4).Cells(x, trig + 2).Value
                Next trig
            End If
        Next celDate
    Next x
End Sub

J'ai essayé de bien commenter pour que ce soit compréhensible.
A toi de me dire si ça convient ou pas.

A bientôt,

 

[loisphil81]

Bonjour MatiChoux
c’est nickel un grand merci !!! pour c'est un peu du chinois
je vais pouvoir faire mes stats individuels.
cool
si tu es dispo sur ce même fichier onglet "Relevé ENE" il y a 2 boutons
qui servent a supprimer des lignes qui contiennent des caractères ou des mots.
pour ca j'ai pioché quelques codes sur les forums et j'ai bidouillé
mais c'est couillon d'avoir 2 boutons si tu y apporte une modification il faut prendre en compte
qu'il est possible que je doivent rajouter des caractères ou des mots car ce sont des données extraite
d'un logiciel.
merci pour ton aide