매크로가 셀의 데이터 유효성 검사를 복사하지 않습니다.

매크로가 셀의 데이터 유효성 검사를 복사하지 않습니다.

시트에서 선택 항목을 복사하여 별도의 첨부 파일로 이메일에 보내는 매크로가 있지만 해당 셀에 있는 데이터 유효성 검사는 복사되지 않습니다.

시트의 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

관련 정보