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

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