Ending a Loop

The use of "activecell" is where you're going awry. Once you've set a range, specifically go through those cells without "selecting" or "offsetting".

Try this:

Sub TESTLOOP()
Dim Rw As Range

    For Each Rw In Selection
        Rw.EntireRow.Copy
    
            'Code to create a report is here.
    
        Worksheets("REPORT").Copy
        ThisWorkbook.Activate
    Next Rw

End Sub

I tried your suggestion and somehow the new code did exactly what the old one did? I have included the entire example below:

Sub TESTLOOP()
Dim Rw As Range

    For Each Rw In Selection
        Rw.EntireRow.Copy
        
    'code to create report starts here
    Sheets("DATA SHEET").Select
    Rows("43:43").Select
    Selection.Insert Shift:=xlDown
    Range("C3:G3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[40]C[-2]"
    Range("C4:G4").Select
    ActiveCell.FormulaR1C1 = "=R[39]C[-1]"
    Range("C5:G5").Select
    ActiveCell.FormulaR1C1 = "=R[38]C"
    Range("C6:G6").Select
    ActiveCell.FormulaR1C1 = "=R[37]C[5]"
    Range("B9:C9").Select
    ActiveCell.FormulaR1C1 = "=R[34]C[19]"
    Range("B10:C10").Select
    ActiveCell.FormulaR1C1 = "=R[33]C[20]"
    Range("B11:C11").Select
    ActiveCell.FormulaR1C1 = "=R[32]C[21]"
    Range("B14:C14").Select
    ActiveCell.FormulaR1C1 = "=R[29]C[10]"
    Range("B15:C15").Select
    ActiveCell.FormulaR1C1 = "=R[28]C[29]"
    Range("B16:C16").Select
    ActiveCell.FormulaR1C1 = "=R[27]C[30]"
    Range("B20:C20").Select
    ActiveCell.FormulaR1C1 = "=R[23]C[15]"
    Range("B24:C24").Select
    ActiveCell.FormulaR1C1 = "=R[19]C[38]"
    Range("B25:C25").Select
    ActiveCell.FormulaR1C1 = "=R[18]C[39]"
    Range("B28:C28").Select
    ActiveCell.FormulaR1C1 = "=R[15]C[38]"
    Range("B29:C29").Select
    ActiveCell.FormulaR1C1 = "=R[14]C[39]"
    Range("B30").Select
    Range("B32:C32").Select
    ActiveCell.FormulaR1C1 = "=R[11]C[40]"
    Range("B33:C33").Select
    ActiveCell.FormulaR1C1 = "=R[10]C[41]"
    Range("B36:C36").Select
    ActiveCell.FormulaR1C1 = "=R[7]C[42]"
    Range("B37:C37").Select
    ActiveCell.FormulaR1C1 = "=R[6]C[43]"
    Range("B38:C38").Select
    ActiveCell.FormulaR1C1 = "=R[5]C[44]"
    Range("B40:C40").Select
    ActiveCell.FormulaR1C1 = "=R[3]C[18]"
    Range("F9:G9").Select
    ActiveCell.FormulaR1C1 = "=R[34]C[18]"
    Range("F10:G10").Select
    ActiveCell.FormulaR1C1 = "=R[33]C[19]"
    Range("F11:G11").Select
    ActiveCell.FormulaR1C1 = "=R[32]C[20]"
    Range("F14:G14").Select
    ActiveCell.FormulaR1C1 = "=R[29]C[21]"
    Range("F15:G15").Select
    ActiveCell.FormulaR1C1 = "=R[28]C[22]"
    Range("F16:G16").Select
    ActiveCell.FormulaR1C1 = "=R[27]C[23]"
    Range("F17:G17").Select
    ActiveCell.FormulaR1C1 = "=R[26]C[24]"
    Range("F20:G20").Select
    ActiveCell.FormulaR1C1 = "=R[23]C[27]"
    Range("F21:G21").Select
    ActiveCell.FormulaR1C1 = "=R[22]C[28]"
    Range("F22:G22").Select
    ActiveCell.FormulaR1C1 = "=R[21]C[29]"
    Range("G23").Select
    ActiveCell.FormulaR1C1 = "=R[20]C[29]"
    Range("G24").Select
    ActiveCell.FormulaR1C1 = "=R[19]C[30]"
    Range("E27:G40").Select
    ActiveCell.FormulaR1C1 = "=R[16]C[42]"
    Range("E41").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
     Rows("42:44").Select
    Selection.Delete Shift:=xlUp
    'code to create report ends here
        
        Worksheets("DATA SHEET").Copy
        ThisWorkbook.Activate
        Call ClearDataSheet
        
    Next Rw

End Sub