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

A

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
Trier par date Trier par votes
vgendron

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
Vote positif 0 Vote négatif
A

ange45

XLDnaute Nouveau
vgendron à dit:
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.
Cliquez pour agrandir...

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:
Vote positif 0 Vote négatif
vgendron

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
 
Vote positif 0 Vote négatif
A

ange45

XLDnaute Nouveau
vgendron à dit:
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
Cliquez pour agrandir...
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"
 
Vote positif 0 Vote négatif
A

ange45

XLDnaute Nouveau
vgendron à dit:
pour éviter les doublons, suffit de vider le tableau avant: bouton "Reinit synthèse"
Cliquez pour agrandir...


Vraiment je vous remercie, depuis ce matin j'essaie de trouver une solution et grâce à vous mon problème est résolu.

c'est Top


Baby Thank You GIF
 
Vote positif 0 Vote négatif
Robert

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
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Bonsoir job75, le fil,

job75 à dit:
Nota : il est inutile et même nuisible que le tableau des résultats soit un tableau structuré.
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
XL 2013 Copier une formule dans un cellule depuis une cellule d'un onglet nouvellement crée en macro VBA
Réponses
8
Affichages
470
pascalou1
P
D
  • Question
VBA pour copier coller une ligne, d'un onglet sur l'autre sur plusieurs onglets
Réponses
0
Affichages
631
Danphyro
D
A
  • Question
Colorier une cellule en rouge quand une échéance arrive a son terme
2
Réponses
23
Affichages
7 K
aktos
A

Membres actuellement en ligne

15 membres et 234 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 095
Messages
2 085 250
Membres
102 837
dernier inscrit
CRETE