Why data is getting copied in the same row?

Found this coding online and tried to use it for one of my workbook. This is not the exact coding as I needed to tweak as per my data.When I click on the button(Macro) 1st time it's correctly moving the data to next sheet. But 2nd time, data is getting replaced . Please help me out as I'm going crazy with this and struggling for weeks now :( .

Sub copycells()
'Error Handler
On Error GoTo scooby_Doo:
 'Dim Varioubles
   Dim DstRng As Range 'destination range
   Dim scrRng As Range 'Sourse Range
   Dim g As Range

    'Destination Vriouble
     Set DstRng = Sheet3.Range("C4")

  'Check completed date is added
  Application.ScreenUpdating = False
  If ActiveCell.EntireRow.Range("A1").Offset(0, 8).Value = "" Then
  MsgBox "You have not added the completed date"
  Exit Sub
  End If

  'limit Range
  If Intersect(ActiveCell, Range("B6:I1100")) Is Nothing Then
  MsgBox "The selected cell is not in the required range ", vbCritical + vbOKOnly
  Exit Sub
  Else

'Give the user a chance to exit here
Select Case MsgBox _
("You are about to finalise this the To Do List." _
& vbCrLf & "Check everything before you proceed", _
vbYesNo Or vbExclamation, "Are you Sure?")
    Case vbYes
    Case vbNo
    Exit Sub
    End Select

    'copy and paste data without selecting
    'set named Range
     ActiveCell.EntireRow.Range("A1").Offset(0, 1).Range("A1:G1").Name = "DataMove"
    ActiveCell.EntireRow.Range("A1").Offset(0, 1).Range("A1:G1").Name = "ClearRng"

    'Source Variable
    Set srcRng1 = Sheet2.Range("DataMove")
    srcRng1.Copy
    DstRng.End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

    'Clear Range
    Sheet2.Range("ClearRng").ClearContents
    Selection.Delete Shift:=xlUp

    'empty clipboard
    Application.CutCopyMode = False

    'confirmation message
    MsgBox "your Completed Task has been sent to Completed" _
    & vbCrLf & "Another one off the list"


    'exitsub error
    End If

    Exit Sub
scooby_Doo:
'message on error
MsgBox "Opps a daisy, something has bottoms up"
On Error GoTo 0
Exit Sub
copycells_Error:
  MsgBox "Error" & Err.Number & " (" & Err.Description & ") in procedure copycells of module copyTo"
  End Sub

Recent Questions...