Copiar "n" veces una celda hacia la derecha, respetando celdas coloreadas

Te dejo la macro desarrollada según tu muestra. El libro con la macro se encuentra a tu disposición. Mis correos aparecen en el sitio que dejo al pie.

Private Sub CommandButton1_Click()
'x Elsamatilde
'si se encuentra seleccionada celda en col A o > F no se ejecuta
If ActiveCell.Column < 2 Or ActiveCell.Column > 6 Then
    MsgBox "Debes seleccionar una celda en rango de días."
    Exit Sub
End If
'no se ejecuta si se seleccionó celda de color
If ActiveCell.Interior.ColorIndex <> xlNone Then
    MsgBox "Debes seleccionar una celda blanca."
    Exit Sub
End If
'se solicita el nro de repeticiones... ajustar el máximo
canti = InputBox("Ingresa el nro de repeticiones.")
If canti < 0 Or canti > 31 Then
    MsgBox "Número no válido"
    Exit Sub
End If
'se ejecutará sobre la celda seleccionada
dato = ActiveCell.Value
sino = MsgBox("¿Deseas rellenar celdas con el nombre " & dato & " ?", vbQuestion + vbYesNo, "CONFIRMAR")
If sino <> vbYes Then Exit Sub
'el dato se repetirá desde la celda activa hasta col F
col1 = ActiveCell.Column + 1
col2 = 6
ini = ActiveCell.Row
fini = Range("A" & Rows.Count).End(xlUp).Row
horario = Format(Cells(ini, 1), "hh:mm")
For i = 1 To canti    'falta
    'si se trata de una col de color no se cuenta
    Do
    If Cells(ini, col1).Interior.ColorIndex <> xlNone Then
        col1 = col1 + 1
    End If
    Loop While Cells(ini, col1).Interior.ColorIndex <> xlNone And col1 <= col2
    'si se completó la fila busca el próximo rango
    If col1 > col2 Then
        Set busco = ActiveSheet.Range("A" & ini + 1 & ":A" & fini).Find(horario, LookIn:=xlValues, lookat:=xlWhole)
        If Not busco Is Nothing Then
            ini = busco.Row
            col1 = 2
        Else
            MsgBox "No hay más horarios para completar"
            Exit For
        End If
    End If
    Cells(ini, col1) = dato
    col1 = col1 + 1
Next i
MsgBox "Fin del proceso."
End Sub

El nro.de repeticiones lo estoy solicitando mediante un inputbox. Allí ajusta la cantidad máxima que te parezca razonable. 

Si esta respuesta resuelve tu consulta no olvides valorarla (Excelente o Buena)... sino comenta la seguimos tratando.

¡Gracias Elsa!

La macro está increíble, y es justo lo que necesitaba! No pensé que se pudiera algo así, y una vez más mi ignorancia me ayudó a que alguien como tú me demostrara lo contrario.

De veras, muchísimas gracias!

Elsa

Buenas tardes

Me quedó una duda, cuando la celdas pintadas están en la columna B (la que corresponde al primer día de la semana), la macro no se las salta y escribe sobre ellas. Eso ocurre solo con con esa columna, ya que cuando están pintadas las otras columnas, la macro funciona perfecto.

Dejo macro ajustada.

Private Sub CommandButton1_Click()
'x Elsamatilde
'si se encuentra seleccionada celda en col A o > F no se ejecuta
If ActiveCell.Column < 2 Or ActiveCell.Column > 6 Then
    MsgBox "Debes seleccionar una celda en rango de días."
    Exit Sub
End If
'no se ejecuta si se seleccionó celda de color
If ActiveCell.Interior.ColorIndex <> xlNone Then
    MsgBox "Debes seleccionar una celda blanca."
    Exit Sub
End If
'se solicita el nro de repeticiones... ajustar el máximo
canti = InputBox("Ingresa el nro de repeticiones.")
If canti < 0 Or canti > 31 Then
    MsgBox "Número no válido"
    Exit Sub
End If
'se ejecutará sobre la celda seleccionada
dato = ActiveCell.Value
sino = MsgBox("¿Deseas rellenar celdas con el nombre " & dato & " ?", vbQuestion + vbYesNo, "CONFIRMAR")
If sino <> vbYes Then Exit Sub
'el dato se repetirá desde la celda activa hasta col F
col1 = ActiveCell.Column + 1
col2 = 6
ini = ActiveCell.Row
fini = Range("A" & Rows.Count).End(xlUp).Row
horario = Format(Cells(ini, 1), "hh:mm")
For i = 1 To canti
    'si se trata de una col de color no se cuenta
    Do
    If Cells(ini, col1).Interior.ColorIndex <> xlNone Then
        col1 = col1 + 1
    End If
    Loop While Cells(ini, col1).Interior.ColorIndex <> xlNone And col1 <= col2
pregunta:
    'si se completó la fila busca el próximo rango
    If col1 > col2 Then
        Set busco = ActiveSheet.Range("A" & ini + 1 & ":A" & fini).Find(horario, LookIn:=xlValues, lookat:=xlWhole)
        If Not busco Is Nothing Then
            ini = busco.Row
            col1 = 2
            'busca la 1er col sin color de la nueva fila
            While Cells(ini, col1).Interior.ColorIndex <> xlNone And col1 <= col2
                col1 = col1 + 1
            Wend
            'si toda la semena fuera feriado
            If col1 > col2 Then GoTo pregunta
        Else
            MsgBox "No hay más horarios para completar"
            Exit For
        End If
    End If
    Cells(ini, col1) = dato
    col1 = col1 + 1
Next i
MsgBox "Fin del proceso."
End Sub

Sdos!

¡Muchísimas Gracias Elsa! 

Nuevamente, la macro está justo como la necesito. De veras muchas gracias.

Saludos

Hola! Mis disculpas por reabrir este hilo. La macro la sigo ocupando tal cual, y me sigue sirviendo muchísimo. Agradezco eternamente la ayuda, porque me ha hecho la vida mucho más simple.

En relación a esa misma macro, y basado en una necesidad que me apareció hace poco, ¿hay alguna forma de que la macro, al copiar los datos hacia la derecha, se salte, además de las columnas en color, las columnas ocultas?

Agradezco mucho la ayuda. Saludos