Я пытаюсь создать общую электронную таблицу, в которой данные передаются с одного рабочего листа на другой, чтобы передаваться из одного отдела во второй.Я настроил его так, чтобы при передаче данных автоматическое электронное письмо отправлялось во второй отдел, чтобы сообщить об этом.
При разработке листа данные копировались с первого листа на следующий, а затем создавался временный лист для копирования данных с целью отправки электронного письма перед его удалением.
Я забыл, когда вы публикуете таблицу, вы не можете удалить листы.Так что теперь он каждый раз создает новый лист, который не идеален.
Мне кажется, мне нужен «временный» лист, чтобы стать постоянным листом (который скрыт).Потребуются данные, чтобы скопировать на него, отправить по электронной почте, а затем очистить содержимое.Новые листы не созданы и ничего не удалено.
'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