Copying the data based on the cells availability and Loop it

Sub IdentifyAgentAAX0to9()
    Dim Rng As Range, A As Variant, e As Variant, sht As Worksheet, n As Long, i As Long, j As Long
    n = 10: i = 0: j = 1
    With Sheets("AMC Agent Breakout")
        .Activate
        For Each e In Array("KAX0", "KAX1", "KAX2", "KAX3", "KAX4", "KAX5", "KAX6", "KAX7", "KAX8", "KAX9")
            .Range("A1:Z" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=8, Criteria1:=e
            .Range("A1:Z" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=18, Criteria1:="0"
            Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows.Count - 1, .AutoFilter.Range.Columns.Count) _
            .SpecialCells(xlCellTypeVisible)
                Range("H:H,P:P,X:X").Select
                Range("X1").Activate
                Selection.Copy
                Sheets("Agent&DRM").Select
                Cells("A", j).Select ' Each and every time copy location should change based on the available space
                ActiveSheet.Paste
                'replace KAX(i) to AAX(i)
                Selection.Replace What:="KAX" & i, Replacement:="AAX" & i, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
            n = n + 1: i = i + 1: j = j + 5000
            .AutoFilterMode = False
        Next
    End With
End Sub