☰

マクロはセル内のデータ検証をコピーしません

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

関連情報