Copier cellule d'une feuille dans une autre sous condition

bonjour

..."J'avais trouvé une macro qui fessait"... :-D


macro à installer dans le module feuille "vacances"
dans la feuille "resume" B9 ne doit pas être vide (un espace suffit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom As String, Lig As Byte
    If Not Intersect(Target, Range("B7:B47")) Is Nothing Then
        Nom = Target.Offset(0, -1)
        With Sheets("resume")
            'suppression d'un X
            If Target = "" Then
                On Error GoTo fin
                Lig = .Columns("B").Find(Nom, .Range("B9")).Row
                .Rows(Lig).Delete
            End If
            'ajout d'un X
            If Target = "X" Then
                Lig = .Columns("B").Find("", .Range("B9")).Row
                .Cells(Lig, "B") = Nom
            End If
         End With
    End If
fin:
End Sub

 Michel

Le tout fonctionne à merveille.

Est ce possible au lieu de supprimer la ligne lorsque l'on retire le X dans la feuille Vacance, de seulement supprimer le nom dans la feuille Resume??

J'ai trouvé, je me devais de modifier se code

Lig = .Columns("B").Find(Nom, .Range("B9")).Row
                .Rows(Lig).Delete

Par celui-ci

Lig = .Columns("B").Find(Nom, .Range("B9")).Row
                .Cells(Lig, "B").ClearContents

Merci beaucoup Michel_M pour ta macro tu m'as réellement éclairé et fait avancer.

J'apporte 2 corrections à mon précédent message (que je viens de relire après envoi, par précaution) :

A) Feuille "Résumé", colonnes A à F, pour 12 lignes.

Vers le début de 2), lire ce qui suit car je n'avais pas prévu que les espaces
seraient concaténés (= réduits), ce qui fait qu'on comprend mal !

'               A       B            C               D               E               F
'       1
'       2            Coche
'       3               x
'       4
'       5             Nom       Coche      Donnée 1   Donnée 2   Donnée 3
'       6
'       7
'       8
'       9
'     10
'     11
'     12

La colonne A est vide : c'est une « marge » ; et cette marge permet
de voir une éventuelle bordure gauche (non visible en colonne A
mais qui serait quand même imprimée si besoin).

---------------------------------------------------------------------------------------

B) Code VBA : la 1ère ligne doit être celle qui sélectionne la feuille "Résumé",
car elle doit être avant l'instruction qui déprotège la feuille active (et aussi
avant les autres lignes de code) ; mes excuses pour l'inversion des 2 premières lignes. Voici donc le nouveau code en entier :

Sub Résumé
  Worksheets("Résumé").Select
  Application.ScreenUpdating = False: ActiveSheet.Unprotect
  Worksheets("Vacances").Range(Plg).AdvancedFilter 2, [B2:B3], [B5]
  ActiveSheet.Protect
End Sub

J'ai bien compris que tu veux avoir seulement les lignes pour lesquelles le nom d'employé (en colonne A) est coché (en colonne B) par exemple par une lettre "X" minuscule : "x" (pas un symbole "croix").

1) Le verbe « avoir » ci-dessus a le sens de « afficher le résultat à l'écran pour le consulter ponctuellement » (et dans ce cas, inutile de copier le résultat obtenu dans une feuille "Résumé").

Solution très simple, sans même utiliser VBA : sur la feuille "Vacances", utiliser manuellement le « filtre automatique » pour afficher seulement les lignes dont la colonne B du tableau contient une coche "x".

-------------------------------------------------------------------------------------

2) Le verbe « avoir » ci-dessus a le sens de « écrire le résultat dans la feuille Résumé pour le lire ensuite aussi souvent que nécessaire » (mais
le résultat sera bien sûr périmé si ultérieurement : ajout ou effacement
de coches "x").

Solution : en utilisant le VBA, appliquer un filtre avancé selon le même critère qu'en 1) dont la destination est la feuille "Résumé". Cette feuille doit contenir le critère de sélection, par exemple en "B2:B3".

A B C D E F
1
2 Coche
3 x
4
5 Nom Coche Donnée 1 Donnée 2 Donnée 3
6
7
8
9
10
11
12

Attention : le nom "Coche" en B2 doit être le même que celui de la feuille "Vacances", colonne B (impératif !).

Le résultat de l'extraction du filtre avancé sera à partir de la ligne 6.

Sub Résumé
  Application.ScreenUpdating = False: ActiveSheet.Unprotect
  Worksheets("Résumé").Select
  Worksheets("Vacances").Range(Plg).AdvancedFilter 2, [B2:B3], [B5]
  ActiveSheet.Protect
End Sub

Remarques importantes :
----------------------------

1) Si on choisit d'aller toujours manuellement sur la feuille "Résumé" avant ' de lancer la macro, on peut, par sécurité, remplacer la 1ère ligne par :

If ActiveSheet.Name <> "Résumé" Then Exit Sub

Ce qui garantit que le code qui suit ne s'exécutera que sur la feuille
de destination "Résumé".

2) À la place de Plg, mettre la plage du tableau "Employés" de la feuille "Vacances" ; cette plage doit obligatoirement inclure la ligne d'en-têtes,
dont bien sûr la colonne "Coche" !

'
'  Le texte suivant est mis en commentaire VBA uniquement à cause
'  des mots clés anglais ! Sinon, le correcteur orthographique bloque
'  dessus et empêche l'envoi du message !
'
'  3) Le 1er paramètre de AdvancedFilter est xlFilterAction ; mettre
'      xlFilterCopy ou sa constante numérique : 2.
'
'  4) Le 2ème paramètre est CriteriaRange, la zone de critères ;
'      mettre la plage du critère de sélection (qui doit être sur la feuille
'      "Résumé") : [B2:B3].
'
'  5) Le 3ème paramètre est CopyToRange, la plage de destination des
'      lignes copiées [B5] ; c'est bien la ligne 5 qui contiendra les en-têtes
'      et pas la ligne 6 des données.
'

-------------------------------------------------------------------------------------

Voici donc une réponse très longue pour :
1) Aucun code VBA si tu veux un résultat ponctuel.
2) Code VBA très court si tu veux écrire le résultat en feuille "Résumé".