☰

宏未复制单元格中的数据验证

tag-icon • tag-icon microsoft-excel vba macros
宏未复制单元格中的数据验证

我有一个宏，可以从工作表中复制选择内容并将其作为单独的附件通过电子邮件发送，但是它不会复制这些单元格中存在的数据验证。

工作表中的 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

答案1

我能够使用下面的代码解决这个问题。

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

相关内容