Microsoft 365 Procédure trop longue

[eric72]

Bonsoir à tous,
J'ai un fichier pour gérer un planning dans lequel j'ai créer un code pour dupliquer la saisie sur la tranche horaire qui suit en double cliquant sur les cellules en rose, cela fonctionne bien mais uniquement pour le lundi et le mardi, si j'ajoute les autres jours il me dit que la procédure est trop longue, le souci c'est que je dois le faire sur les 6 jours.
L'un d'entre vous a-t-il une idée sur ce sujet.
Merci beaucoup pour votre dévouement.
Eric

 

[TooFatBoy]

En effet, par contre quelle est l'astuce pour ne pas que cela fonctionne si on double click sur e14?

Ensuite on suit exactement le même raisonnement pour les colonnes.

 

[eric72]

Merci beaucoup pour tout, au cas ou j'ai crée un autre post pour mon second problème (sans vouloir abuser).
Bonne soirée

 

[TooFatBoy]

Je vais essayer de trouver un PC, pour t'envoyer une version plus simple, dans la journée.

Voici la version "plus simple" dont je parlais.

Elle consiste juste à revenir en arrière pour revenir à une seule macro :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    With Target

        ' Vérification de la validité de la ligne
        If ((.Row Mod 7) <> 0) Or (.Row > 448) Or ((((.Row / 7) - 1) Mod 8) = 0) Then Exit Sub

        ' Vérification de la validité de la colonne
        If (((.Column + 8) Mod 12) <> 0) Or (.Column > 64) Then Exit Sub

        Cancel = True

        Application.ScreenUpdating = False

        ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13
        .Offset(7, 1).Value = .Offset(0, 1).Value       ' E21 = E14

    End With

End Sub