Pick number continuous selection VBA

[Goalexcel]

Hello there, and thank you in advance for your help.
I've been using the following code that I got in this site:

Extracting number from a range randomly

Hello Expert, please kindly advise what is the best method to extract numbers from a range randomly I have a series of numbers in the range of A1 to T16. I would like to extract 3 differents numbers from each columns, and place them in column A21, B21so on. I wonder. if there is a way to do...

www.mrexcel.com

I would like to say thank you for the code to @Peter_SSs. The code is:

Sub Pick_N_v2()
  Dim d As Object
  Dim a As Variant, b As Variant, Results As Variant
  Dim c As Long, i As Long, k As Long, ShNum As Long, PicksMade As Long, NumsLeft As Long
  Dim PickHowMany As Long, Rws As Long, Cols As Long, NextClr As Long, ResultsHeaderRow As Long
  
  Randomize
  Set d = CreateObject("Scripting.Dictionary")
  For ShNum = 1 To 5
    With Sheets(ShNum)
      Application.Goto Reference:=.Range("A1"), Scroll:=True
      Rws = .Range("A1").End(xlDown).Row - 1
      Cols = .Cells(1, Columns.Count).End(xlToLeft).Column
      ResultsHeaderRow = .Range("A1").End(xlDown).End(xlDown).Row
      PicksMade = .Range("A" & ResultsHeaderRow).CurrentRegion.Rows.Count - 1
      If PicksMade > 0 Then
        b = .Range("A" & ResultsHeaderRow + 1).Resize(PicksMade, Cols).Value
        NextClr = .Range("A" & Rows.Count).End(xlUp).Interior.ColorIndex + 2
      Else
        NextClr = 4
      End If
      NumsLeft = Rws - PicksMade
      Do
        PickHowMany = Application.InputBox("Pick how many numbers? (Max = " & NumsLeft & ")", .Name, IIf(NumsLeft > 3, 3, NumsLeft), , , , , 1)
      Loop Until PickHowMany <= NumsLeft
      If PickHowMany > 0 Then
        With .Range("A2").Resize(Rws, Cols)
          a = .Value
          ReDim Results(1 To PickHowMany, 1 To Cols)
          For c = 1 To UBound(a, 2)
            d.RemoveAll
            For i = 1 To Rws
              d(a(i, c)) = i
            Next i
            If PicksMade > 0 Then
              For i = 1 To PicksMade
                d.Remove b(i, c)
              Next i
            End If
            For i = 1 To PickHowMany
              k = 1 + Int(Rnd() * d.Count)
              Results(i, c) = d.Keys()(k - 1)
              .Cells(d.Items()(k - 1), c).Interior.ColorIndex = NextClr
              d.Remove Results(i, c)
            Next i
          Next c
        End With
        With .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(PickHowMany, UBound(Results, 2))
          .Select
          .Value = Results
          .Interior.ColorIndex = NextClr
        End With
      Else
        MsgBox "Zero picks chosen. Sheet '" & .Name & "' has been skipped"
      End If
    End With
  Next ShNum
  Application.ScreenUpdating = True
End Sub

1. What need is to change the way how to pick the number, we need to select 4 continuous rows and copy down.
2. The range start A2 and count to end.
2. Next pick number will do the same using the input box. See image below.