Copier coller un peu spécial

bonsoir

je me permets de publier cette demande.

James m'a fait une super macro qui permet d’accéder en double cliquant sur le nom d'une personne dans n'importe quelle feuille d'un planning de 52 feuilles (Une par semaine) à un résumé de ces 52 semaines sur une feuille appelée "récap"

ça marche très bien, mais à utiliser ce fichier je me dis qu'aujourd'hui j'aurais besoin d'une fonction supplémentaire... je voudrais pouvoir recopier des changements opérés sur la feuille "récap" vers toutes les semaines de la personne sélectionnée. Avec si possible une message box du genre : "êtes-vous sûr de... "

êtes vous en mesure de m'aider ?

merci d'avance pour le temps que vous voudrez bien y consacrer.

13test4.xlsm (298.40 Ko)

Bonjour,

Je te propose plutôt de tout entretenir dans un seul onglet, puis de jouer sur des filtres ou des segments pour n'afficher que la semaine en question. On voit là encore les limites de gérer des onglets par période.

A toutes fins utiles, j'ai retrouvé ceci : la saisie est faite dans un onglet mais toutes les valeurs sont reportées dans une "base de données". Le changement d'année ou de semaine rafraîchit l'ensemble des informations affichées. On pourrait décomposer la journée en matin/apm.

Bonsoir Steelson

et désolé pour ma réponse tardive, les vacances sont passées par là

ce fichier est effectivement très très intéressant, je pense que je vais me pencher dessus pour l'année 2020

j'ai dans la réalité bcp de choses à transposer, il y a un beau chantier mais je pense que ça en vaut le coup !

en attendant, entrevois tu une solution à mon souci actuel ou si comme je le suppose, ma demande est irréalisable sur mon fichier ?

en attendant, entrevois tu une solution à mon souci actuel ou si comme je le suppose, ma demande est irréalisable sur mon fichier ?

je n'ai pas regardé

ta demande est très spécifique mais elle est réalisable

que dis James ?

Bonsoir

je me permets de vous relancer... si quelqu'un d'entrevous avait une idée lumineuse

merci

Bonjour,

Je préférerais travailler de suite sur la version https://forum.excel-pratique.com/viewtopic.php?p=792230#p792230

Néanmoins, je vais reprendre ce sujet en l'état. Note qu'il faut aligner le nom des onglets avec les valeurs de la feuille récap, notamment au niveau des semaines. Par exemple S06 et s6 ...

J'ai greffé à ton code une seconde partie.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub

If Target.Address = "$E$7" Then

    On Error Resume Next                    'à la première instruction qui provoque une erreur, on passe outre
    Sheets("s" & Range("E7")).Activate      'on active la feuille qui a comme nom "s" suivi du nombre écrit en D1
    If Err.Number <> 0 Then                 'si on a eu une instruction en erreur (ex : une fuille qui n'existe pas)
        Exit Sub                            'on arrête la macro
    End If
    Sheets("récap").Range("E7").ClearContents   'sinon, on a déjà activé la feuille de la semaine demandée

Else

    Dim cel As Range
    If Target.Column >= 3 And Target.Column <= 16 And (Target.Row Mod 4) = 2 Then
        With Sheets(CStr(Cells(Int(Target.Row / 4) * 4, 2)))
            Set cel = .Range("B:B").Find(Range("B10"))
            If Not cel Is Nothing Then .Cells(cel.Row, Target.Column).Value = Target.Value
        End With
    End If

End If

End Sub

Une fois la codification des semaines choisie et mise en cohérence, on pourra ajuster le code.

avec mise en cohérence des noms d'onglets et codification des semaines dans récap

5test4.xlsm (301.67 Ko)

Merci bcp Steelson ça fonctionne très bien !!

je note un tout petit bug : dans la feuille "récap" si j'écrit dans une cellule et que je la tire depuis son coin inférieur droit pour la dupliquer sur toute la ligne, la recopie sur les feuilles S ne fonctionne pas. Est-ce contournable ?

Oui je peux le traiter facilement ...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, ici As Range

If Not Intersect(Target, Range("$E$7")) Is Nothing Then

    On Error Resume Next
    Sheets("S" & Right("00" & Range("E7"), 2)).Activate
    If Err.Number <> 0 Then Exit Sub
    Sheets("récap").Range("E7").ClearContents

End If

For Each cel In Target

    If cel.Column >= 3 And cel.Column <= 16 And (cel.Row Mod 4) = 2 Then
        With Sheets(CStr(Cells(Int(cel.Row / 4) * 4, 2)))
            Set ici = .Range("B:B").Find(Range("B10"))
            If Not ici Is Nothing Then .Cells(ici.Row, cel.Column).Value = cel.Value
        End With
    End If

Next

End Sub
4test4.xlsm (302.29 Ko)
Rechercher des sujets similaires à "copier coller peu special"