Try running this:

Sub RandomPull2()
    Dim r As Range
    Dim rs As Long, r2 As Double, c As Long, max As Long
    
    Set r = Worksheets("Key List").Range("Table5[Key]")
    max = r.rows.Count
    rs = CLng(max / 100 * 25) 'percentage - adjust accordingly
    
    c = 0
    Randomize
    With CreateObject("scripting.dictionary")
        Do While c < rs
            r2 = Rnd
            r2 = (r2 * 1000000) - ((max - 1) * Int((r2 * 1000000) / (max - 1))) + 1
            Do While .Exists(r(r2).Value)
                r2 = Rnd
                r2 = (r2 * 1000000) - ((max - 1) * Int((r2 * 1000000) / (max - 1))) + 1
            Loop
            .Add r(r2).Value, 1
            c = c + 1
        Loop
        Worksheets("Random List").Range("A1").Resize(.Count) = Application.Transpose(.keys)
    End With
    Set r = Nothing
End Sub