Hi Gergo,

This code works perfectly!

I use an extension of your code so it can pick five random movies from the array and copy it in the template. Here it is:"

Sub Button2_Documentary_Final()
'declare variables
Dim ShFrom As Worksheet, ShTo
Dim RngTo As Range
Dim MyArray()
Dim a As Integer, i, x, y, c, d, e

'give values to variables
Set ShFrom = Sheets("Documentary") '<-- change this if you want
Set ShTo = Sheets("Schedule Template")
ShTo.Activate
Set RngTo = Application.InputBox("Select destination cell:" _
            & vbCrLf & "(macro picks up row value)", _
            "Row where data will be pasted", Type:=8)
'store not bolded row's numbers in array
For i = 2 To ShFrom.Cells(Rows.Count, 1).End(xlUp).Row
    If ShFrom.Cells(i, 1).Font.Bold = False Then
        ReDim Preserve MyArray(a)
        MyArray(a) = i
        a = a + 1
    End If
Next i
'randomly pick one, copy it to schedule template and bold it
x = Int((a - 0 + 1) * Rnd + 0)
ShTo.Range("D" & RngTo.Row) = ShFrom.Range("A" & MyArray(x))
ShTo.Range("E" & RngTo.Row) = ShFrom.Range("B" & MyArray(x))
ShTo.Range("F" & RngTo.Row) = ShFrom.Range("C" & MyArray(x))
ShFrom.Range("A" & MyArray(x), "C" & MyArray(x)).Font.Bold = True

y = Int((a - 0 + 1) * Rnd + 0)
ShTo.Range("D" & RngTo.Row + 1) = ShFrom.Range("A" & MyArray(y))
ShTo.Range("E" & RngTo.Row + 1) = ShFrom.Range("B" & MyArray(y))
ShTo.Range("F" & RngTo.Row + 1) = ShFrom.Range("C" & MyArray(y))
ShFrom.Range("A" & MyArray(y), "C" & MyArray(y)).Font.Bold = True

c = Int((a - 0 + 1) * Rnd + 0)
ShTo.Range("D" & RngTo.Row + 2) = ShFrom.Range("A" & MyArray(c))
ShTo.Range("E" & RngTo.Row + 2) = ShFrom.Range("B" & MyArray(c))
ShTo.Range("F" & RngTo.Row + 2) = ShFrom.Range("C" & MyArray(c))
ShFrom.Range("A" & MyArray(c), "C" & MyArray(c)).Font.Bold = True

d = Int((a - 0 + 1) * Rnd + 0)
ShTo.Range("D" & RngTo.Row + 3) = ShFrom.Range("A" & MyArray(d))
ShTo.Range("E" & RngTo.Row + 3) = ShFrom.Range("B" & MyArray(d))
ShTo.Range("F" & RngTo.Row + 3) = ShFrom.Range("C" & MyArray(d))
ShFrom.Range("A" & MyArray(d), "C" & MyArray(d)).Font.Bold = True

e = Int((a - 0 + 1) * Rnd + 0)
ShTo.Range("D" & RngTo.Row + 4) = ShFrom.Range("A" & MyArray(e))
ShTo.Range("E" & RngTo.Row + 4) = ShFrom.Range("B" & MyArray(e))
ShTo.Range("F" & RngTo.Row + 4) = ShFrom.Range("C" & MyArray(e))
ShFrom.Range("A" & MyArray(e), "C" & MyArray(e)).Font.Bold = True

Erase MyArray

End Sub
Thank you so much for your time!

Greetings,

Attila