Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Copier une ligne s'il y a une cellule en "ROUGE" dans celle-ci

ange45

XLDnaute Nouveau
Bonjour,

Je suis entrain de faire un tableau pour le suivi des formations.
Sur mon onglet "Tableau de bord" j'ai fais 2 mises en forme conditionnelle. La date en ROUGE si elle dépasse la date d'aujourdhui et en ORANGE pour me prévenir 3 mois avant.


Maintenant je voudrais sur un autre onglet nommée "Synthèses" ravoir le même tableau, mai en ayant seulement les lignes si les dates sont en ROUGE ou ORANGE.

Pour mes 2 onglets mes tableaux commences en C15 et fini en K15.

Apparemment c'est possible avec du VBA. mais je n'ai aucune notion malheureusement.

Est ce que quelqu'un peu m'aider svp?
 

Pièces jointes

  • essaie DRH FORMATIONS.xlsx
    57.5 KB · Affichages: 11

vgendron

XLDnaute Barbatruc
le meme mais avec collage special valeur (pour éviter de copier les formules)
et avec des commentaires dans le code

pour voir le code:
ouvrir l'éditeur vba: Alt+F11
dans l'explorateur à gauche, double clic sur le module 1 du projet
et à droite, le code apparait.
 

Pièces jointes

  • essaie DRH FORMATIONS.xlsm
    65 KB · Affichages: 11

ange45

XLDnaute Nouveau

Super, c'est bien ce que je souhaite.

Partcontre si je rajoute une donnée sur le tableau "TABLEAU DE BORD" et que je reclique sur le bouton mes date presente sur mon onglet "Syntheses" sont en doublon

Je vais tester et regarder le code

merci encore
 
Dernière édition:

vgendron

XLDnaute Barbatruc
PS: j'ai réduit volontairement les tableaux au strict minimum
un des intérêts des tableaux structurés, c'est qu'il suffit d'ajouter des donner juste sous le tablo pour que celui ci s'adapte automatiquement en taille
je leur ai donné des noms plus parlant et plus pratique pour s'y retrouver


en plus, avoir des tableaux à rallonge, vide, ca augmente inutilement la taille des fichiers
 

ange45

XLDnaute Nouveau
J'ai regardé le code VBA, c'est wouuaaa

Pour être franche j'y comprend rien du tout

Savez vous comment faire pour eviter les doublons si on reclique sur le bouton "generer synthese"
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

Grillé grave par Vgendron qui a été rapide sur ce coup !... Tans pis j'envoie quand même ma proposition puisque j'y ai passé pas mal de temps...
En pièce jointe ton fichier modifié avec le code ci-dessous :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As ListObject 'déclare la variable TS (Tableau Source)
Dim TD As ListObject 'déclare la variable TD (Tableau Destination)
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)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("Tableau de bord") 'définit l'onglet OS
Set OD = Worksheets("Synthèses") 'définit l'onglet OD
Set TS = OS.ListObjects("Tableau6") 'définit le tableau TS
Set TD = OD.ListObjects("Tableau4") 'définit le tableau TD
If TD.ListRows.Count > 0 Then TD.DataBodyRange.Delete 'efface les données de TD si TD contient au moins une ligne
For I = 1 To TS.ListRows.Count 'boucle sur toutes les lignes I de TS
    If TS.DataBodyRange(I, 8) <> "" Then 'condition 1 : si la valeur en colonne 8 n'est pas vide
        'condition 2 : reprend les deux conditions de la MFC,si une des condition est vérifiée
        If CDate(TS.DataBodyRange(I, 8)) < Date Or DateSerial(Year(CDate(TS.DataBodyRange(I, 8))), Month(CDate(TS.DataBodyRange(I, 8))) - 3, Day(CDate(TS.DataBodyRange(I, 8)))) < Date Then
            Set R = TD.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TD)
            If R Is Nothing Or TD.ListRows.Count = 0 Then 'condition 3 : si aucune occurrence n'est trouvée ou si TD ne contient aucune ligne
                TD.ListRows.Add 'ajoute une ligne à TD
                LI = TD.ListRows.Count 'définit la ligne LI (la dernière ligne de TD)
            Else 'sinon (au moins une occurrence est trouvée)
                LI = R.Row - TD.HeaderRowRange.Row + 1 'définit la ligne LI (ligne de la première occurence trouvée moins la ligne des en-têtes de TD plus une)
            End If 'fin de la condition 3
            TS.ListRows(I).Range.Copy 'copie la ligne I de TS
            TD.DataBodyRange(LI, 1).PasteSpecial (xlValues) 'colle les valeurs dans les données de TD ligne LI colonne 1
            'récupère le nom et prénom (parfois non renseigné en colonne 1 de TS)
            TD.DataBodyRange(LI, 1) = IIf(TS.DataBodyRange(I, 1) <> "", TS.DataBodyRange(I, 1).Value, TS.DataBodyRange(I, 1).End(xlUp).Value)
            'récupère la matricule (parfois non renseignée en colonne 2 de TS)
            TD.DataBodyRange(LI, 2) = IIf(TS.DataBodyRange(I, 2) <> "", TS.DataBodyRange(I, 2).Value, TS.DataBodyRange(I, 1).End(xlUp).Offset(0, 1).Value)
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
Application.CutCopyMode = False 'suprimme le clignotement lié au copier/coller
OD.Activate 'active l'onglet OD
OD.Range("C14").Select 'sélectionne la cellule C14 de OD
End Sub
Le fichier :
 

Pièces jointes

  • Balfourier_ED_v01.xlsm
    70.9 KB · Affichages: 1

job75

XLDnaute Barbatruc
Bonjour balfourier, vgendron, Robert,

Voici une solution très simple qui utilise le filtre avancé.

Voyez le fichier joint et cette macro dans le code de la feuille "Synthèses" :
VB:
Private Sub Worksheet_Activate()
Dim r As Range
Application.ScreenUpdating = False
Range("C16:J" & Rows.Count).Delete xlUp
With Sheets("Tableau de bord").ListObjects(1).Range
    On Error Resume Next 'si aucune SpecialCell
    Set r = .Columns(1).Resize(, 2).SpecialCells(xlCellTypeBlanks)
    r = "=R[-1]C" 'remplit les cellules vides avec la valeur au-dessus
    .Cells(2, 10) = "=(J16<>"""")*((J16<TODAY())+(J16<EDATE(TODAY(),3)))" 'critère
    .AdvancedFilter xlFilterCopy, .Cells(1, 10).Resize(2), [C15:J15] 'filtre avancé copié
    .Cells(2, 10) = ""
    r = ""
End With
End Sub
Elle se déclenche automatiquement quand on active la feuille.

Nota : il est inutile et même nuisible que le tableau des résultats soit un tableau structuré.

A+
 

Pièces jointes

  • essaie DRH FORMATIONS(1).xlsm
    60.9 KB · Affichages: 3

job75

XLDnaute Barbatruc
Avec ce fichier (2) la MFC sur la colonne J est copiée :
VB:
Private Sub Worksheet_Activate()
Dim r As Range
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Range("C16:J" & Rows.Count).Delete xlUp
With Sheets("Tableau de bord").ListObjects(1).Range
    On Error Resume Next 'si aucune SpecialCell
    Set r = .Columns(1).Resize(, 2).SpecialCells(xlCellTypeBlanks)
    r = "=R[-1]C" 'remplit les cellules vides avec la valeur au-dessus
    .Cells(2, 10) = "=(J16<>"""")*((J16<TODAY())+(J16<EDATE(TODAY(),3)))" 'critère
    .AdvancedFilter xlFilterCopy, .Cells(1, 10).Resize(2), [C15:J15] 'filtre avancé copié
    .Cells(2, 10) = ""
    r = ""
    '---copie la MFC---
    If [J16] = "" Then Exit Sub
    Set r = ActiveCell
    .Cells(2, 8).Copy
    Range("J16", Range("J" & Rows.Count).End(xlUp)).PasteSpecial xlPasteFormats 'collage spécial Formats
    Application.CutCopyMode = 0
    r.Select
End With
End Sub
 

Pièces jointes

  • essaie DRH FORMATIONS(2).xlsm
    61.9 KB · Affichages: 2

soan

XLDnaute Barbatruc
Inactif
Bonsoir job75, le fil,

Nota : il est inutile et même nuisible que le tableau des résultats soit un tableau structuré.

incroyable ! c'est la première fois que je lis un post d'un des adeptes des tableaux structurés qui informe qu'un tableau structuré est déconseillé ! (dans le cas présent)

donc ça rejoint mon opinion : un tableau structuré n'est pas forcément la panacée, et ça n'est pas à utiliser systématiquement ! merci, job75 !

soan
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…