copy cells from sheets based on date, paste to another sheet

I have now created a separate module which is called from the worksheet change event. This appears to run further but now gets stuck where I am copying data. Annotated below.

 Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
Call CheckPaySchSO

End Sub
------
Sub CheckPaySchSO()

Dim Today
Today = Date
    
    Sheets("CoA").Select
    Range("I47").Select

    Do While ActiveCell.Value <> ""
        
        If ActiveCell.Value < Today Then ' checks to see if contract date is before the present date - if yes go to next evaluation
        
            If ActiveCell.Offset(0, 7).Value = "" Then ' if there is no previous accounting entry date then
                
                If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then ' if contract start plus one frequency period is before present date
                     Call enterdata                   ' create entries on Receipts & Payments
                                    
                End If
                
            Else
                If ActiveCell.Offset(0, 7).Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then    ' if last entry plus one frequency period is before present date
    
                     Call enterdata                   ' create entries on Receipts & Payments
                End If
            End If
        End If
    
    ActiveCell.Offset(1, 0).Select 'evaluate next row
        
    Loop ' Until IsEmpty(ActiveCell) = True
    
    Exit Sub

End Sub

Private Sub enterdata()

ActiveWorkbook.Sheets("Receipts & Payments").Activate
Range("a10").Select

    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If

    Loop Until IsEmpty(ActiveCell) = True

    ActiveCell.Value = Sheets("CoA").ActiveCell.Value  'Gets stuck here
    ActiveCell.Offset(0, 1) = Sheets("CoA").ActiveCell.Offset(2, 0).Value
    ActiveCell.Offset(0, 2) = Sheets("CoA").ActiveCell.Offset(3, 0).Value
    ActiveCell.Offset(0, 3) = Sheets("CoA").ActiveCellOffset(5, 0).Value
    ActiveCell.Offset(0, 4) = Sheets("CoA").ActiveCell.Offset(4, 0).Value
    ActiveCell.Offset(0, 10) = Sheets("CoA").ActiveCell.Offset(6, 0).Value
    
    ActiveWorkbook.Sheets("CoA").Activate
 
        If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then
                ActiveCell.Offset(0, 7).Value = ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value)
                ' if contract start plus one frequency period is before present date
        Else: ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(0, 7).Value + Month(ActiveCell.Offset(0, 1).Value)
                                    
        End If
                
End Sub

Presumably this is not the correct way to copy the cells of the rows that meet the if criteria. So how do I do this?