Hi arnelgp.... sorry for disturbing With more edits
I've just found a simple issue so I would like some help for resolving it.
Firstly ... your code is running well exactly as I need
But the only problem is that the number of rows may increase or decrease in the Source sheet
so the old data must be cleard first before transferring the new data in Two worksheets ( successful & Unsuccessful )
Is there any additional lines should be add to achieve that?
Option Explicit

Public Sub agp_arnelgp()
    
    Const NAME_COLUMN As Integer = 5
    Const CODE_COLUMN As Integer = 4
    Const ADDRESS_COLUMN As Integer = 3
    Const CREDITOR_COLUMN As Integer = 12
    Const DEBTOR_COLUMN As Integer = 13
    Const FIRST_CASE_COLUMN As Integer = 10
    Const SECOND_CASE_COLUMN As Integer = 11
    
    Dim oXml As Object
    Dim oRst As Object
    Dim oRng As Range
    Dim rw As Long
    Dim var As Variant, sValue As String
    Dim whl As Variant, dec As Variant, pos As Integer
    Dim line1 As Long, row1 As Long
    Dim Criteria As String, Cnt As Integer, i As Integer, j As Integer
    With Worksheets("SOURCE")
        'the Columns are A upto N
        Set oRng = .Range("A7:N" & .Cells(8, 1).End(xlDown).Row)
    End With
    Set oRst = CreateObject("ADODB.Recordset")
    Set oXml = CreateObject("MSXML2.DOMDocument")
    oXml.LoadXML oRng.Value(xlRangeValueMSPersistXML)
    oRst.Open oXml
    
    'count how many records to loop
    With oRst
        Do While Not .EOF
            If UCase(.Fields(FIRST_CASE_COLUMN) & .Fields(SECOND_CASE_COLUMN)) = "YEXCELLENT" Then
                Cnt = Cnt + 1
            Else
                Exit Do
            End If
            .MoveNext
        Loop
    End With
    
    With oRst
        .Filter = "[" & .Fields(10).Name & "]='Y' And [" & .Fields(11).Name & "]='Excellent'"
        line1 = 18: row1 = 0
        
        For i = 1 To Cnt
            .MoveFirst
            If i > 1 Then
                For j = 2 To i
                    .MoveNext
                Next
            End If
                    
            Do While Not .EOF
                line1 = line1 + 1: row1 = row1 + 1
                If row1 Mod 28 = 0 Then
                    
                    Sheets("Template").Select
                    ActiveWindow.SmallScroll Down:=-15
                    Range("A17:G46").Select
                    Selection.Copy
                    Sheets("expected for a successful").Select
                    Range("A" & line1 + 1).Select
                    ActiveSheet.Paste
    
                    Sheets("expected for a successful").HPageBreaks.Add Before:=Cells(line1 + 1, 1)
                    line1 = line1 + 3
                    row1 = 1
                End If
                
                With Worksheets("expected for a successful")
                    .Cells(line1, 1) = oRst(NAME_COLUMN) & ""
                    .Cells(line1, 2) = oRst(CODE_COLUMN) & ""
                    .Cells(line1, 3) = oRst(ADDRESS_COLUMN) & ""
                        
                    whl = 0
                    dec = 0
                    
                    sValue = oRst(CREDITOR_COLUMN) & ""
                    pos = InStr(1, sValue, ".")
                    whl = Val(sValue)
                    dec = 0
                    If pos <> 0 Then
                        dec = Mid$(sValue, pos)
                        whl = Val(Replace$(sValue, dec, ""))
                        dec = Val(Replace$(dec, ".", ""))
                    End If
                    If dec <> 0 Then
                        .Cells(line1, 4) = dec
                    End If
                    If whl <> 0 Then
                        .Cells(line1, 5) = whl
                    End If
                    
                    whl = 0
                    dec = 0
                    sValue = oRst(DEBTOR_COLUMN) & ""
                    pos = InStr(1, sValue, ".")
                    whl = Val(sValue)
                    dec = 0
                    If pos <> 0 Then
                        dec = Mid$(sValue, pos)
                        whl = Val(Replace$(sValue, dec, ""))
                        dec = Val(Replace$(dec, ".", ""))
                    End If
                    If dec <> 0 Then
                        .Cells(line1, 6) = dec
                    End If
                    If whl <> 0 Then
                        .Cells(line1, 7) = whl
                    End If
                End With
                For j = 1 To Cnt
                    .MoveNext
                    If .EOF Then
                        Exit For
                    End If
                Next
            Loop
        Next
        
        .Filter = "[" & .Fields(10).Name & "]<>'Y' And [" & .Fields(11).Name & "]='Excellent'"
        line1 = 18: row1 = 0
        
        For i = 1 To Cnt
            .MoveFirst
            If i > 1 Then
                For j = 2 To i
                    .MoveNext
                Next
            End If
                    
            Do While Not .EOF
                line1 = line1 + 1: row1 = row1 + 1
                If row1 Mod 28 = 0 Then
                    
                    Sheets("Template").Select
                    ActiveWindow.SmallScroll Down:=-15
                    Range("A17:G46").Select
                    Selection.Copy
                    Sheets("expected for a Unsuccessful").Select
                    Range("A" & line1 + 1).Select
                    ActiveSheet.Paste
    
                    Sheets("expected for a Unsuccessful").HPageBreaks.Add Before:=Cells(line1 + 1, 1)
                    line1 = line1 + 3
                    row1 = 1
                End If
                
                With Worksheets("expected for a Unsuccessful")
                    .Cells(line1, 1) = oRst(NAME_COLUMN) & ""
                    .Cells(line1, 2) = oRst(CODE_COLUMN) & ""
                    .Cells(line1, 3) = oRst(ADDRESS_COLUMN) & ""
                        
                    whl = 0
                    dec = 0
                    
                    sValue = oRst(CREDITOR_COLUMN) & ""
                    pos = InStr(1, sValue, ".")
                    whl = Val(sValue)
                    dec = 0
                    If pos <> 0 Then
                        dec = Mid$(sValue, pos)
                        whl = Val(Replace$(sValue, dec, ""))
                        dec = Val(Replace$(dec, ".", ""))
                    End If
                    If dec <> 0 Then
                        .Cells(line1, 4) = dec
                    End If
                    If whl <> 0 Then
                        .Cells(line1, 5) = whl
                    End If
                    
                    whl = 0
                    dec = 0
                    sValue = oRst(DEBTOR_COLUMN) & ""
                    pos = InStr(1, sValue, ".")
                    whl = Val(sValue)
                    dec = 0
                    If pos <> 0 Then
                        dec = Mid$(sValue, pos)
                        whl = Val(Replace$(sValue, dec, ""))
                        dec = Val(Replace$(dec, ".", ""))
                    End If
                    If dec <> 0 Then
                        .Cells(line1, 6) = dec
                    End If
                    If whl <> 0 Then
                        .Cells(line1, 7) = whl
                    End If
                End With
                For j = 1 To Cnt
                    .MoveNext
                    If .EOF Then
                        Exit For
                    End If
                Next
            Loop
        Next
        
        
        .Close
    End With
    
    Set oRst = Nothing
    Set oXml = Nothing
    Set oRng = Nothing
End Sub
Would appreciate if you can have a look....Thank you Sir