Question

我正在尝试设计一个共享电子表格，其中数据从一个工作表传输到另一个工作表，然后从一个部门传递到另一个部门。我进行了设置，以便在传输数据时，会自动向第二部门发送一封电子邮件，以告知他们。

设计工作表时，将数据从第一张工作表复制到下一张工作表，然后创建一个临时工作表以将数据复制到该工作表中，以便在发送电子邮件之前将其删除。

共享电子表格时我忘记了，您无法删除工作表。因此，现在每次都创建一个新表，这是不理想的。

我认为我需要一个“临时”纸才能变成永久纸（被隐藏）。它需要将数据复制到上面，通过电子邮件发送出去，然后清除内容。没有创建新工作表，也没有删除任何内容。

'Set variables
Set sht1 = Sheets("xDepartment")
Set sht2 = Sheets("yDepartment")

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

'Select Entire Row
Intersect(Selection.EntireRow, Selection.Parent.Columns("N")).Value = Date

With Intersect(Selection.EntireRow, Selection.Parent.Range("A:N"))
    .Copy Destination:=sht2.Range("A" & lastRow + 1)
    lastRow2 = sht2.Range("A" & sht2.Rows.Count).End(xlUp).Row
    .EntireRow.Delete
End With

Set sht3 = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
sht3.Name = "temp"
'Note: if the selection is one cell it will send the whole worksheet
Set Sendrng = sht2.Range("A" & (lastRow + 1) & ":N" & lastRow2)
Sendrng.Copy Destination:=sht3.Range("A1")

On Error GoTo StopMacro

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Create the mail and send it
sht3.Activate
lastRow2 = sht3.Range("A" & sht3.Rows.Count).End(xlUp).Row
Set Sendrng = sht3.Range("A1:N" & lastRow2)

With Sendrng

    ActiveWorkbook.EnvelopeVisible = True
    With .Parent.MailEnvelope

        ' Set the optional introduction field thats adds
        ' some header text to the email body.
        .Introduction = "New work sent from xDepartment"

        With .Item
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = ""
            .Send
        End With

    End With
End With

StopMacro:

Application.DisplayAlerts = False
ActiveWorkbook.Sheets("temp").UsedRange.ClearContents
Application.DisplayAlerts = True

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False
Worksheets("xDepartment").Activate
MsgBox ("Work has been passed to yDepartment.")

Whoops:
 Application.EnableEvents = True

End Sub

复制到现有工作表上，然后清除内容

0 个答案: