Макрос не копирует проверку данных в ячейках

Question

У меня есть макрос для копирования выделенного фрагмента из листа и отправки его по электронной почте в виде отдельного вложения, однако он не копирует проверку данных, которая существует в этих ячейках.

В таблице есть проверка, которая существует в столбцах AT, AU, AV, AW и AY. Когда я запускаю код ниже, он не копирует проверку в отправляемый по электронной почте лист. Мне нужно, чтобы вложение имело ту же проверку в этих столбцах, что и исходный лист, и то же форматирование.

Sub send_email()
Dim Data, Dict As Object, Id As String, File As String, i As Long
Set Dict = CreateObject("scripting.dictionary")
With Cells(1).CurrentRegion
    Data = .Value
    For i = 2 To UBound(Data)
        If Not Dict.exists(Data(i, 59)) Then
            Id = Data(i, 58)
            File = ThisWorkbook.Path & "\" & Id & " - PCP" & ".xlsx"
            Dict.Add Data(i, 59), 1
            .AutoFilter 59, Data(i, 59)
            .SpecialCells(12).Copy Sheets.Add.Cells(1)
            With ActiveSheet
                .Copy
                With ActiveWorkbook
                    .ActiveSheet.Name = "Sheet1"
                    .SaveAs File
                    .Close
                End With
                Application.DisplayAlerts = False: .Delete: Application.DisplayAlerts = True
            End With
            With CreateObject("Outlook.Application").CreateItem(0)
                .display
                .To = Data(i, 59)
                .Subject = "Work Assignment for Today"
                .HTMLBody = "Good Morning " & "<br><br>" & "Please find attached your work assignment for the day" & .HTMLBody
                .Attachments.Add File
                .display '! Change to Send after testing
            End With
            Kill File
            .AutoFilter
        End If
    Next i
End With
End Sub

Answer 1

Мне удалось решить эту проблему с помощью приведенного ниже кода.

ActiveWorkbook.Worksheets(Array(.Name, "Disp")).Copy