Copying X amount of names from list and enter in another column

Option Explicit


Sub CopyOver()


Dim Ws1 As Worksheet
Dim rPrelims As Range, r1stRound As Range, jColCell As Range
Dim Ws1Lrow As Long
Dim strCell As String
Set Ws1 = ThisWorkbook.Sheets(1)
Set rPrelims = Ws1.Range("B6")
Set r1stRound = Ws1.Range("B8")


'   Find last used row number on Column D Sheet 1
    Ws1Lrow = Ws1.Columns(4).Find(What:="*", LookIn:=xlValues, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlPrevious, _
        MatchCase:=False, searchformat:=False).Row
        
'   B6 & B8 are not empty
    If Not IsEmpty(rPrelims) And Not IsEmpty(r1stRound) Then
    
'   Copy the number of players in Prelim cell to column H
        Ws1.Range(Ws1.Cells(3, 4), Ws1.Cells(rPrelims.Value + 2, 4)).Copy Ws1.Range("H3")
        
'   Copy the remainder of players to column K
        Ws1.Range(Ws1.Cells(rPrelims.Value + 3, 4), Ws1.Cells(Ws1Lrow, 4)).Copy Ws1.Cells(rPrelims.Value + 3, 11)
        
'   Set the cell in column J which will hold the player number after the last one in column G
        Set jColCell = Ws1.Cells(rPrelims.Value + 3, 10)
        
'   Get the non absolute address of the cell
        strCell = jColCell.Address(False, False)
        
'   Put the place +1 of the last player in column G
        jColCell = Ws1.Cells(rPrelims.Value + 2, 7) + 1
        
'   Put formula in the rest of the range in column J
        Ws1.Range(Ws1.Cells(rPrelims.Value + 4, 10), Ws1.Cells(Ws1Lrow, 10)).Formula = "=(" & strCell & ")+1" ' Equiv =J3+1
    
    End If
    
Exit Sub


End Sub