Code not looping correctly

Frustrated here as I had this code working then after adding a few extras found that it was not looping correctly. After trying to fix it I could still not find where the problem is. It is only running through the loop one time. I think the problem is the following code in bold near the bottom but I cannot work out how it should go.

ActiveCell.Offset(20, 0).Select
End If
Next
End With
Else
End If
NTDS = MsgBox(

Sub Generate_TDS()


'Generate team sheets based on Teams listed on reference sheet
CDchk = MsgBox("Do you wish to clear data first?", vbYesNo, "Clear Data?")
If CDchk = 6 Then
Application.ScreenUpdating = False
Application.Run "Clear_for_season"
Else
End If
GTDS = MsgBox("Are you sure you wish to generate the Team Data Sheets? ", vbYesNo, "Generate Team Data Sheets")
If GTDS = 6 Then

'MsgBox "Updating References from Team Nominations", , "References"
Application.Run "ListFiles"
Application.Run "Update_Reference_Sheet"
Application.ScreenUpdating = True
Sheets("References").Select
Application.ScreenUpdating = False
Dim i As Integer

With Sheets("References")
    For i = 6 To 46
    Dim nm
    nm = Worksheets("References").Cells(i, 2)
        If Cells(i, 2) <> "" Then
            Sheets("TDS Template").Copy before:=Worksheets("End") 'Copies the template sheet to before sheet 'End'
            Sheets("TDS Template (2)").Range("am6").Value = (nm) 'Pastes team name
            Sheets("TDS Template (2)").Name = (nm) ' Puts team name on template
    
    
    'Place team player data on All Players, Best and Fairest and Ring-Ins sheet
    Sheets("All Players TP").Select
    Range("A6:n25").Select
    Selection.Copy
    Sheets("All Players").Select
    Range("A6").Select
    Do Until ActiveCell = ""
     If ActiveCell <> "" Then
     ActiveCell.Offset(20, 0).Select
     Else
    End If
    Loop
    ActiveSheet.Paste
    Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
   ActiveCell.Offset(20, 0).Select 'to increment 20 places
        
    Sheets("All Players TP").Select
    Range("t6:Az25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Best and Fairest").Select
    Range("A6").Select
    Do Until ActiveCell = ""
     If ActiveCell <> "" Then
     ActiveCell.Offset(20, 0).Select
     Else
    End If
    Loop
    ActiveSheet.Paste
    Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveCell.Offset(20, 0).Select
    
    Sheets("All Players TP").Select
    Range("bb6:db25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ring In Players").Select
    Range("A6").Select
    Do Until ActiveCell = ""
        If ActiveCell <> "" Then
        ActiveCell.Offset(20, 0).Select
         Else
        End If
    Loop
    ActiveSheet.Paste
    Selection.Replace What:="tds template", Replacement:=(nm), LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveCell.Offset(20, 0).Select
    End If
    Next
End With
   Else
   End If
   NTDS = MsgBox("Do you wish to update data from the nominations to the Team Data Sheets?", vbYesNo, "Nomination Data Updata")
         If NTDS = 6 Then
  Application.Run "input_teams" 'Macro to put team nominations onto Team Data sheets
    Else
    End If
          
          
    Sheets("Co-ord Menu").Select


End Sub