XL 2010 copier la cellule sélectionnée à des intervalles réguliers sur un même ligne

[michel.dupont]

Bonjour à tous
cela ne devrait pas être trop compliqué pour les spécialistes des macros
sur une feuille représentant un agenda je souhaiterais que le cellules sélectionnées (une représentant une heure l'autre un événement) soient recopiées tous les x jours , le x étant déterminé par une donnée encodée dans une msg box (si j'indique 30 sur la msgbox les cellule selectionnées seront recopiées 30 colonnes plus loin sur la même ligne, si j'indique 10 dans la msgbox les cellules sélectionnées seront recopiées 10 colonnes plus loin sur la même ligne ).Ce recopiage serait limité à une plage dont la fin serait identifié par une cellule content le mot "fin".L'idéal est qu'on puisse indiquer la date de fin dans la MSG box
je vous adresse un petit fichier pour une meilleur compréhension.
Merci de votre intérêt pour mon petit souci
bonne soirée à tous
Michel

 

[sylvanu]

Bonsoir Michel,
Un essai en PJ à tester et retester.

Sub Copier()
Dim Resultat$, NbCol%, NbCol2%, Ligne%, Colonne%, N%
On Error GoTo Erreur
Ligne = ActiveCell.Row
Colonne = ActiveCell.Column
NbCol = Application.Match("Fin", Range(Ligne & ":" & Ligne), 0)
If Not IsNumeric(ActiveCell) Then
    MsgBox "Veuillez cliquer sur une cellule contenant un horaire. Merci."
    Exit Sub
End If
Resultat = InputBox("Les données " & Chr(10) & _
        Format(ActiveCell, "hh:mm") & " " & Cells(Ligne, Colonne + 1) & Chr(10) & _
        "vont être dupliquées jusqu'au " & Cells(7, NbCol + 1) & Chr(10) & _
        "Veuillez donner le nombre de jours entre deux insertions  ?", "Dupliquer informations")
If Resultat <> "" And IsNumeric(Resultat) Then  'Si la valeur est différente de "" on continue
    For N = Colonne To NbCol Step 2 * Resultat
        If LCase(Cells(Ligne, N)) <> "fin" Then
            Cells(Ligne, N) = Format(Cells(Ligne, Colonne), "hh:mm")
            Cells(Ligne, N + 1) = Cells(Ligne, Colonne + 1)
        End If
    Next N
End If
Exit Sub
Erreur:
MsgBox "Erreur. Pas de FIN trouvé sur cette ligne."
End Sub

Règle : Après avoir mis une heure et une opération mettre Fin.
Se positionner sur l'heure et cliquer sur le bouton.

 

[michel.dupont]

super un tout grand merci
bonne journée
Michel