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

Question

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.

Answer 1

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

Answer 2

I have a macro that copies row by row of a selected range and pastes it on the next one. Maybe it'll help out.
Also, if you know the number of rows you're working with, you can always do
Range(Ax:Lx).Select
If not, this might do the trick:
Dim i As Integer
i = 2 //1 if first row isn't headers.
Do While sht1.Range("A" & i).Value <> Empty
sht1.Range("A" & i & "L" & i).Select
Selection.Copy
sht2.Range("A" & lastrow +1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = i + 1
Loop
Let me know if it helps or it needs adjustment.