Скопируйте на существующий лист и очистите содержимое после - PullRequest
0 голосов
/ 04 января 2019

Я пытаюсь создать общую электронную таблицу, в которой данные передаются с одного рабочего листа на другой, чтобы передаваться из одного отдела во второй.Я настроил его так, чтобы при передаче данных автоматическое электронное письмо отправлялось во второй отдел, чтобы сообщить об этом.

При разработке листа данные копировались с первого листа на следующий, а затем создавался временный лист для копирования данных с целью отправки электронного письма перед его удалением.

Я забыл, когда вы публикуете таблицу, вы не можете удалить листы.Так что теперь он каждый раз создает новый лист, который не идеален.

Мне кажется, мне нужен «временный» лист, чтобы стать постоянным листом (который скрыт).Потребуются данные, чтобы скопировать на него, отправить по электронной почте, а затем очистить содержимое.Новые листы не созданы и ничего не удалено.

'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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...