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

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.

The issue is that you use `Range("A" & ActiveCell.Row & ":L" & ActiveCell.Row).Select` which obviously only selects one row. So you need to replace the first `ActiveCell.Row` with the row that you want to start with and the second `ActiveCell.Row` with the row you want to end with. • You should also read and apply [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). If you want to get columns A to L of the selected rows use `Selection.EntireRow.Resize(ColumnSize:=12)` — Pᴇʜ, Dec 11 '18 at 12:30

score 0 · Answer 1 · answered Dec 11 '18 at 12:42

0

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.

answered Dec 11 '18 at 12:42

Matías Romo

100
6

For your Interest: I recommend to read (and apply to every code) [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). Also copying row by row in a loop is extremely slow. • And you must use `Long` for row counting variables `Dim i As Long`. Excel has more rows than `Integer` can handle. – Pᴇʜ Dec 11 '18 at 12:53
Thanks! Most of the things I've learned are self-taught. So it definitely helps to have feedback on it. The assumption I use for my simulations and I assumed this code too, was that there wasn't a huge amount of rows implied, hence why I used integer, but I see that long is a better use case. – Matías Romo Dec 12 '18 at 14:26

Pᴇʜ · Accepted Answer · 2018-12-11T15:03:59.013

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

Hi PEH. Thanks, you're a genius. It now works for single rows and adjacent rows, but if I try to select non-adjacent rows, I get an error (Run time error 1004). Do you know how I might edit the code to let me select multiple rows that aren't next to one another? — Liz H, Dec 11 '18 at 14:17
@LizH: Instead of `Selection.EntireRow.Resize(ColumnSize:=12)` use `Intersect(Selection.EntireRow, Selection.Parent.Range("A:L"))` — Pᴇʜ, Dec 11 '18 at 14:27
@PEH That's amazing, that works perfectly thank you. I know this isn't in the remit of the question I asked originally, but do you know if there's a way for me to then record the date that the transfer was made in column M next to the rows that get passed over? — Liz H, Dec 11 '18 at 14:56

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

2 Answers2