Copy paste and delete from one sheet into another

I'm currently trying to work some VBA code into my excel file that makes it so when I click on a Row I can click on a button to copy that row onto a different sheet and then the row gets deleted. I'm able to get all of that to work except I was wondering if there was a way to make it so I can copy & delete multiple rows? right now I can only do one at a time.

The Code is listed below, not sure if its possible to enhance it or change it so lets say I select a random number of rows and click on the copy button it can all paste at the same time.

Sub CopyToReturn()

    ActiveCell.EntireRow.Select
    Selection.Copy
    Sheets("Return Source").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    Sheets("DLS-Route").Select
    Selection.EntireRow.Delete


End Sub

Try this:

Option Explicit
Sub CopyToReturn()
    
    'Declarations.
    Dim RngSource As Range
    Dim RngDestination As Range
    Dim RngArea As Range
    Dim RngCell As Range
    Dim RngChop As Range
    Dim DblBottomRow As Double
    Dim DblTopRow As Double
    Dim DblRow As Double
    
    'Settings.
    Set RngSource = Selection
    Set RngDestination = Sheets("Return Source").Range("A1").End(xlDown)
    
    
    'Checking if RngDestination is empty, which means its not the last cell of the list.
    If Excel.WorksheetFunction.CountBlank(RngDestination) = RngDestination.Cells.Count Then
        
        'Setting RngDestination.
        Set RngDestination = RngDestination.End(xlUp).Offset(1, 0)
    
    Else
        
        'Setting RngDestination.
        Set RngDestination = RngDestination.Offset(1, 0)
        
    End If
    
    'Covering each area of RngSource.
    For Each RngArea In RngSource.Areas
        
        'Covering each cell of RngArea.
        For Each RngCell In RngArea.Cells
            
            'Checking if RngChop is nothing.
            If RngChop Is Nothing Then
                
                'Setting RngChop.
                Set RngChop = RngCell.EntireRow
                
            Else
                
                'Setting RngChop.
                Set RngChop = Union(RngChop, RngCell.EntireRow)
                
            End If
            
        Next
        
    Next
    
    'Covering each row of RngChop.
    For Each RngArea In RngChop.Rows
        
        'Copying the row.
        RngArea.Copy RngDestination
        
        'Setting RngDestination for the next row.
        Set RngDestination = RngDestination.Offset(1, 0)
        
    Next
    
    'Deleting RngChop.
    RngChop.Delete
    
End Sub