Cut/paste range of cells into another sheet and send an email

I have some code that almost works exactly as I'd like, below. At the moment, I have two sheets, one for Y-department, and one for X-department. I'd like a button to pass a range of cells (A:L) from the Y-department sheet to the X-department sheet. I don't want to paste the entire row because there are formulae from M-W in the X-department sheet, which get overwritten when I do that.

At the moment, this almost works. But it only lets me pass one row at a time. Is it possible to edit this code so that I can select more than one row at a time and it will cut and paste (only cells A:L of) all of those rows onto the X-department sheet?

Thanks in advance!

Sub Pass_to_Xdepartment()

If MsgBox("Do you want to pass the selected tours to Xdepartment?", vbYesNo, "Pass to XDepartment") = vbNo Then Exit Sub

For Each WSheet In ActiveWorkbook.Worksheets
        If WSheet.AutoFilterMode Then
            If WSheet.FilterMode Then
                WSheet.ShowAllData
            End If
        End If
        For Each DTable In WSheet.ListObjects
            If DTable.ShowAutoFilter Then
                DTable.Range.AutoFilter
                DTable.Range.AutoFilter
            End If
        Next DTable
    Next WSheet

'Declare variables
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Dim lastRow As Long

'Set variables
    Set sht1 = Sheets("YDepartment")
    Set sht2 = Sheets("XDepartment")

'Select Entire Row
    Range("A" & ActiveCell.Row & ":L" & ActiveCell.Row).Select

'Move row to destination sheet & Delete source row
    lastRow = sht2.Range("A" & sht2.Rows.Count).End(xlUp).Row

    With Selection
        .Copy Destination:=sht2.Range("A" & lastRow + 1)
        .EntireRow.Delete
    End With

End Sub

Also, out of interest, do you know if there's a way to set up this button so that it sends an email at the same time as passing over the data to notify X-department when rows have been passed over to their sheet? This is a secondary concern though.

Solution

Some suggestions, some "must haves":

Avoid using Select in Excel VBA
Obviously Range("A" & ActiveCell.Row & ":L" & ActiveCell.Row) is only one row because ActiveCell is a single cell not a range of cells. If you want to get columns A to L of the selected range use …
```
Selection.EntireRow.Resize(ColumnSize:=12) '= first 12 columns of selection
```
All your Range and Cells should be specified with a worksheet like sht1.Range.
Use meaningful variable names eg replace sht1 with wsSource and sht2 with wsDestination which makes your code much easier to understand.
Don't test your message box like If MsgBox(…) = vbNo Then instead test for If Not MsgBox(…) = vbYes. Otherwise pressing the X in the right top corner of the window has the same effect as pressing the Yes button.
Make sure you really mean ActiveWorkbook (= the one that has the focus / is on top) and not ThisWorkbook (= the one this code is running in).
I recommend to activate Option Explicit: In the VBA editor go to Tools › Options › Require Variable Declaration and declare all your variables properly.

So you end up with something like:

Option Explicit

Public Sub Pass_to_Xdepartment()
    If Not MsgBox("Do you want to pass the selected tours to Xdepartment?", vbYesNo, "Pass to XDepartment") = vbYes Then
        Exit Sub
    End If

    Dim ws As Worksheet, DTable As ListObject
    For Each ws In ThisWorkbook.Worksheets
        If ws.AutoFilterMode Then
            If ws.FilterMode Then
                ws.ShowAllData
            End If
        End If
        For Each DTable In ws.ListObjects
            If DTable.ShowAutoFilter Then
                DTable.Range.AutoFilter
                DTable.Range.AutoFilter
            End If
        Next DTable
    Next ws

    Dim wsSrc As Worksheet
    Set wsSrc = ThisWorkbook.Worksheets("YDepartment")

    Dim wsDest As Worksheet
    Set wsDest = ThisWorkbook.Worksheets("XDepartment")

    Dim LastRow As Long
    LastRow = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Row

    'Move row to destination sheet & Delete source row
    With Selection.EntireRow.Resize(ColumnSize:=12) '= A:L of the selected rows
        .Copy Destination:=wsDest.Cells(LastRow + 1, "A")
        .EntireRow.Delete
    End With
End Sub

Edit according to comments (write date):

Since you delete the copied rows anyway you can first write the date to column M

    Intersect(Selection.EntireRow, Selection.Parent.Columns("M")).Value = Date

And then copy A:M instead of A:L

    With Intersect(Selection.EntireRow, Selection.Parent.Range("A:M")) '= A:M of the selected rows
        .Copy Destination:=wsDest.Cells(LastRow + 1, "A")
        .EntireRow.Delete
    End With