XL 2010 Ecrire des données automatiquement sur des feuilles

jeje77

jeje77

XLDnaute Junior
Bonjour à tous,

J’ai des tableaux liés entre eux sur des feuilles différentes, est-il possible d'écrire automatiquement les lettres" XP " dans les cases surlignées dès lors que c'est un week-end ou un jour fériés.

Les feuilles des mois (Janv_1, Fevr_1, Mars_1 etc ... normalement il y en à 48 Jusqu’à Dec_4) vont chercher les données sur la feuille "CALENDRIERS UT" Pour les jours de gardes et sur la feuille "EFFECTIFS" pour les jours fériés.

Le surlignage dans les feuilles des mois se fait à l’aide de MFC

Lors des changements d'année le surlignage change dans les différentes feuilles des mois suite aux changement des dates de la feuille « CALENDRIER UT ».


Précédemment, j’ai ouvert une discussion « Écrire automatiquement des données dans des cellules » en date du 29/10/2019, mais j’ai mal formulé ma demande d’aide et dans le fichier exemple j’ai regroupé les tableaux sur une même feuille.



Je ne trouve pas comment faire pour adapter le code aux feuilles de mon classeur.
Je ne sais pas ou modifier le code qui permettrait de pouvoir inscrire les « XP » sur mes différentes feuilles


Ci-joint un exemple de mon fichier, et le fichier de Job75

Par avance je vous remercie pour votre aide

Cordialement
 

Pièces jointes

  • De job75 Test XP(2) OK.xlsm
    55 KB · Affichages: 8
  • gestion Absences.xlsm
    124.3 KB · Affichages: 8
Trier par date Trier par votes
P

projetRH

XLDnaute Nouveau
oui, il te faut une feuille dédiée des jours fériés. Ensuite tu n'as plus qu'a demander à excel de faire l'action que tu veux si la date du calendrier = une date fériée. On trouve plusieurs exemples en ligne d'édition de feuilles de fériés ad vitam aeternam
 
Vote positif 0 Vote négatif
jeje77

jeje77

XLDnaute Junior
Bonjour Projet RH
merci de lire mon post

en fait j'ai une plage nommée "feries" dans la feuille "EFFECTIFS".
Sur le fichiers de Job75 ça fonctionne tres bien mais dans mon classeur je n'arrive pas à transposé son code pour mes feuilles "Janv_1, Fevr_1, Mars_1 etc ... "
Chaque équipe à une plage nommée par mois sur la feuille "CALENDRIER UT"ce qui me permet de retrouver sur les feuilles des mois les jours correspondant aux jours de gardes surlignées par des MFC.
Il arrive qu'il y ai des oublis et les "XP" qui correspondent au prime de repas ne sont pas reportés, donc pas payé à la fin du mois.
Voila pourquoi je voudrait avoir une macro qui inscrive automatiquement "XP" dans les cellules surlignées de la plage B3:G33 dès lors que c'est un week-end ou un jour fériés.

Cordialement
jeje77
 
Vote positif 0 Vote négatif
P

projetRH

XLDnaute Nouveau
Je ne me suis servi que d'un seul fichier : job75, je t'ai mis une formule dans la colonne F de la feuille 1, qui inscrit XP automatiquement. C'est une formule matricielle, il te faut taper [Ctrl + shift + entrée] pour la valider quand tu la modifiera. Tu me diras si ça répond à tes attentes.
 

Pièces jointes

  • De job75 Test XP(2) OK (1).xlsm
    46.4 KB · Affichages: 7
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir jeje77, projetRH,

Il a fallu revoir complètement la macro, la voici dans le module standard MAJ du fichier joint :
VB: 
Sub MAJ_XP()
'---se lance par les touches Ctrl+M---
Dim tablo, d As Object, i&, j%
If Not IsDate(Replace(ActiveSheet.Name, "_", "/")) Then Exit Sub
If MsgBox("Les XP vont être entrés, voulez-vous continuer ?", 4) = 7 Then Exit Sub
'---liste des jours de garde---
With Sheets("CALENDRIERS UT")
    tablo = .Range("E9", .Range("E" & .Rows.Count).End(xlUp)) 'matrice, plus rapide, à adapter
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If tablo(i, 1) <> "" Then If Weekday(tablo(i, 1), 2) > 5 Or Application.CountIf([Feries], tablo(i, 1)) Then d(tablo(i, 1)) = ""
Next i
'---traitement du tableau de destination---
With [A1].CurrentRegion
    tablo = .Columns(2).Resize(, 6) 'matrice, plus rapide
    For i = 3 To UBound(tablo)
        If d.exists(.Cells(i, 1).Value) Then
            For j = 1 To 6
                tablo(i, j) = "XP"
            Next j
        End If
    Next i
    Application.ScreenUpdating = False
    With .Columns(2).Resize(, 6)
        .Replace "XP", "", xlWhole 'RAZ
        .Value = tablo 'restitution
    End With
End With
End Sub
Allez sur une feuille de mois et lancez la macro par les touches Ctrl+M.

Bonne nuit.
 

Pièces jointes

  • gestion Absences(1).xlsm
    121.6 KB · Affichages: 9
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Ceci va mieux car on utilise le texte UT1 ou UT2 etc... situé en A1 des feuilles de mois :
VB: 
Sub MAJ_XP()
'---se lance par les touches Ctrl+M---
Dim UT As Range, tablo, d As Object, i&, nlig&, ncol%, j%
With Sheets("CALENDRIERS UT")
    Set UT = .Rows("8:9").Find(Left([A1], 3), , xlValues) 'recherche en lignes 8-9 à adapter
    If UT Is Nothing Then Exit Sub
    tablo = .Range(UT, .Cells(.Rows.Count, UT.Column).End(xlUp)) 'matrice, plus rapide
    If Not IsArray(tablo) Then Exit Sub 'sécurité
End With
If MsgBox("Les XP vont être entrés, voulez-vous continuer ?", 4) = 7 Then Exit Sub
'---liste des jours de garde---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If tablo(i, 1) <> "" Then If Weekday(tablo(i, 1), 2) > 5 Or Application.CountIf([Feries], tablo(i, 1)) Then d(tablo(i, 1)) = ""
Next i
'---traitement du tableau de destination---
With [A1].CurrentRegion
    nlig = .Rows.Count
    If nlig = 1 Then nlig = nlig + 1 'au moins 2 éléments
    ncol = .Columns.Count - 2 'colonne Commentaires déduite
    If ncol < 1 Then ncol = 1
    tablo = .Columns(2).Resize(nlig, ncol) 'matrice, plus rapide
    For i = 3 To nlig
        If d.exists(.Cells(i, 1).Value) Then
            For j = 1 To ncol
                tablo(i, j) = "XP"
            Next j
        End If
    Next i
    Application.ScreenUpdating = False
    With .Columns(2).Resize(, ncol)
        .Replace "XP", "", xlWhole 'RAZ
        .Value = tablo 'restitution
    End With
End With
End Sub
Fichier (2).
 

Pièces jointes

  • gestion Absences(2).xlsm
    122.9 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
jeje77

jeje77

XLDnaute Junior
projetRH à dit:
Je ne me suis servi que d'un seul fichier : job75, je t'ai mis une formule dans la colonne F de la feuille 1, qui inscrit XP automatiquement. C'est une formule matricielle, il te faut taper [Ctrl + shift + entrée] pour la valider quand tu la modifiera. Tu me diras si ça répond à tes attentes.
Cliquez pour agrandir...

Merci pour cette solution mais je ne peux pa mettre de formules dans ces cellules, car celle-ci sont modifiable en rentrant differents codes.
Je vais voir le fichier que Job75 à modifier
 
Vote positif 0 Vote négatif
jeje77

jeje77

XLDnaute Junior
job75 à dit:
Ceci va mieux car on utilise le texte UT1 ou UT2 etc... situé en A1 des feuilles de mois :
VB: 
Sub MAJ_XP()
'---se lance par les touches Ctrl+M---
Dim UT As Range, tablo, d As Object, i&, nlig&, ncol%, j%
With Sheets("CALENDRIERS UT")
    Set UT = .Rows("8:9").Find(Left([A1], 3), , xlValues) 'recherche en lignes 8-9 à adapter
    If UT Is Nothing Then Exit Sub
    tablo = .Range(UT, .Cells(.Rows.Count, UT.Column).End(xlUp)) 'matrice, plus rapide
    If Not IsArray(tablo) Then Exit Sub 'sécurité
End With
If MsgBox("Les XP vont être entrés, voulez-vous continuer ?", 4) = 7 Then Exit Sub
'---liste des jours de garde---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If tablo(i, 1) <> "" Then If Weekday(tablo(i, 1), 2) > 5 Or Application.CountIf([Feries], tablo(i, 1)) Then d(tablo(i, 1)) = ""
Next i
'---traitement du tableau de destination---
With [A1].CurrentRegion
    nlig = .Rows.Count
    If nlig = 1 Then nlig = nlig + 1 'au moins 2 éléments
    ncol = .Columns.Count - 2 'colonne Commentaires déduite
    If ncol < 1 Then ncol = 1
    tablo = .Columns(2).Resize(nlig, ncol) 'matrice, plus rapide
    For i = 3 To nlig
        If d.exists(.Cells(i, 1).Value) Then
            For j = 1 To ncol
                tablo(i, j) = "XP"
            Next j
        End If
    Next i
    Application.ScreenUpdating = False
    With .Columns(2).Resize(, ncol)
        .Replace "XP", "", xlWhole 'RAZ
        .Value = tablo 'restitution
    End With
End With
End Sub
Fichier (2).
Cliquez pour agrandir...

Bonjour Job75,
je viens de tester les deux fichiers que tu as modifié, ils fonctionnent bien.
Quand je met la macro "MAJ" dans mon fichier et que je la lance avec CTRL + MAJ, celle-ci bloque au niveau de la ligne :
If tablo(i, 1) <> "" Then If Weekday(tablo(i, 1), 2) > 5 Or Application.CountIf([Feries], tablo(i, 1)) Then d(tablo(i, 1)) = ""
Je ne comprend pas pourquoi cela ne fonctionne pas car le fichier que j'ai mis c'est le même que le fichier que je me sert au travail.
Merci pour l'aide apportée
Ci-joint la capture d'écran et mon fichier si ça peut aider.
 

Pièces jointes

  • Erreur execution 13.JPG
    Erreur execution 13.JPG
    45.7 KB · Affichages: 11
  • Ligne macro.JPG
    Ligne macro.JPG
    25.3 KB · Affichages: 10
  • gestion Absences XP (3).xlsm
    600 KB · Affichages: 7
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Ce n'est pas le même fichier, dans celui de votre post #8 il y a 2 choses qui entrainent un bug :

- la plage des jours fériés a été modifiée, maintenant elle s'appelle Feriés, les accents comptent...

- dans la feuille CALENDRIERS UT il y a des titres (UT) en lignes 70 et 132.

Le fichier en retour, j'ai modifié le code avec :
VB: 
'---liste des jours de garde---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    v = tablo(i, 1)
    If IsDate(v) Then If Weekday(v, 2) > 5 Or Application.CountIf([Feriés].EntireColumn, v) Then d(v) = ""
Next i
Edit : attention, dans la feuille janv_2 la colonne I n'était pas vide, elle doit toujours l'être pour isoler le tableau...
 

Pièces jointes

  • gestion Absences XP (3).xlsm
    594 KB · Affichages: 8
Dernière édition:
Vote positif 0 Vote négatif
jeje77

jeje77

XLDnaute Junior
Merci Job75


La macro fonctionne très bien quand le fichier est déprotégé, et bug quand j'ai remet la protection. La macro je pense ne peut pas sélectionner les colonnes suite à la protection des feuilles

J'ai écrit une macro qui m'ôte la protection du fichier avant la sélection de la feuille et le lancement de la macro « MAJ », et remet la protection du fichier après avoir écrit sur toutes les feuilles les « XP ».

Encore merci pour votre patience envers les néophytes.
Bien cordialement
jeje77


VB: 
Sub Ecrire_XP()
'
' TEST_XP Macro
'
' Déprotection feuilles

    Call Deprotection_des_feuilles
'
' Ecriture "XP"

    Sheets("janv_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("fev_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("mar_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("avr_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("mai_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("juin_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("juil_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("aou_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("sep_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("oct_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("nov_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("dec_1").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"

'
    Sheets("janv_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("fev_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("mar_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("avr_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("mai_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("juin_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("juil_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("aou_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("sep_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("oct_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("nov_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("dec_2").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
'
    Sheets("janv_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("fev_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("mar_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("avr_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("mai_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("juin_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("juil_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("aou_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("sep_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("oct_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("nov_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("dec_3").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
'
    Sheets("janv_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("fev_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("mar_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("avr_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("mai_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("juin_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("juil_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("aou_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("sep_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("oct_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("nov_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"
    Sheets("dec_4").Select
    Application.Run "'gestion Absences XP (3).xlsm'!MAJ_XP"

        Range("B3").Select

    
    Call Protection_des_feuilles
    
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Je refais mon message.

Si l'on veut traiter toutes les feuilles des mois avec leur protection on utilisera ce fichier (4) et la macro :
VB: 
Sub MAJ_XP()
'---se lance par les touches Ctrl+M---
Dim w As Worksheet, UT As Range, tablo, d As Object, i&, v As Variant, nlig&, ncol%, j%
Application.ScreenUpdating = False
For Each w In Worksheets
    With Sheets("CALENDRIERS UT")
        Set UT = .Rows("8:9").Find(Left(w.[A1], 3), , xlValues) 'recherche en lignes 8-9 à adapter
        If UT Is Nothing Then GoTo 1
        tablo = .Range(UT, .Cells(.Rows.Count, UT.Column).End(xlUp)) 'matrice, plus rapide
        If Not IsArray(tablo) Then GoTo 1 'sécurité
    End With
    '---liste des jours de garde---
    Set d = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tablo)
        v = tablo(i, 1)
        If IsDate(v) Then If Weekday(v, 2) > 5 Or Application.CountIf([Feriés].EntireColumn, v) Then d(v) = ""
    Next i
    '---traitement du tableau de destination---
    w.Unprotect Password:="yj" 'déprotection de la feuille
    With w.[A1].CurrentRegion
        nlig = .Rows.Count
        If nlig = 1 Then nlig = nlig + 1 'au moins 2 éléments
        ncol = .Columns.Count - 2 'colonne Commentaires déduite
        If ncol < 1 Then ncol = 1
        tablo = .Columns(2).Resize(nlig, ncol).Formula 'matrice des formules, plus rapide
        For i = 3 To nlig
            If d.exists(.Cells(i, 1).Value) Then
                For j = 1 To ncol
                    tablo(i, j) = "XP"
                Next j
            End If
        Next i
        With .Columns(2).Resize(, ncol)
            .Replace "XP", "", xlWhole 'RAZ
            .Formula = tablo 'restitution
        End With
    End With
    w.Protect Password:="yj" 'protection de la feuille
    w.EnableSelection = xlNoRestrictions 'toutes les cellules peuvent être sélectionnées
1 Next w
End Sub
Nota : je n'avais pas vu qu'il y avait des formules en ligne 2, j'ai donc ajouté des .Formula pour le tableau de destination.

Bonne nuit.
 

Pièces jointes

  • gestion Absences XP (4).xlsm
    601.7 KB · Affichages: 13
Vote positif 0 Vote négatif

Discussions similaires

A
  • Résolu(e)
XL 2016 Calculer l’occurrence d’un nom sur plusieurs feuilles
Réponses
14
Affichages
382
ACMadara
A
O
  • Résolu(e)
XL 2016 Transfert de données sous conditions
Réponses
4
Affichages
183
sylvanu
sylvanu
B
  • Question
XL 2013 Transposition de filtres multiples sur plusieurs feuilles
Réponses
11
Affichages
250
BIROULIG
B
hypo78
  • Question
XL 2016 Récupérer données sur plusieurs feuilles
2
Réponses
18
Affichages
561
Lolote83
L
B
  • Question
XL 2019 ventiler une base de données sur plusieurs feuilles d'un même classeur
Réponses
5
Affichages
230
bernardhericher
B
F
  • Question
Microsoft 365 liste validation des données qui se réduit après sélection
Réponses
6
Affichages
362
fabchaninarom
F
D
  • Question
Microsoft 365 RECHERCHEV sur deux tableaux distincts avec une mise à jour automatique
Réponses
3
Affichages
130
chris
chris
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation de la création de feuilles en fonction des données de la cellule U13 et une feuille type
Réponses
7
Affichages
258
chaelie2015
chaelie2015
W
  • Question
XL 2021 Double boucle
Réponses
2
Affichages
183
whiteshark
W
G
  • Question
Microsoft 365 Ajouter et supprimer des données sur tableau de bord
Réponses
6
Affichages
461
grace2023
G

Membres actuellement en ligne

3 membres et 35 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 196
Messages
2 086 098
Membres
103 116
dernier inscrit
kutobi87