■

Sub メール画面表示マクロ()
Dim outlookApp As Object
Dim outlookMail As Object
Dim ws As Worksheet
Dim mailSheet As Worksheet
Dim addrList As Range
Dim cell As Range
Dim recipients As String
Dim title As String
Dim body As String

' Outlookアプリケーションを作成
Set outlookApp = CreateObject("Outlook.Application")

' メール本文が格納されているシートとセルを指定
Set mailSheet = ThisWorkbook.Sheets("メール")
title = mailSheet.Range("A2").Value ' タイトル
body = mailSheet.Range("B2").Value ' 本文

' シート1からシート3までの各シートに対して処理を行う
For Each ws In ThisWorkbook.Sheets(Array("アドレス1", "アドレス2", "アドレス3"))
' メールアイテムを作成
Set outlookMail = outlookApp.CreateItem(0)

' アドレスのリストが格納されているセル範囲を指定
Set addrList = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)

' リスト内の各アドレスをBccに追加
For Each cell In addrList
' 空白でない場合にのみアドレスをBccに追加
If cell.Value <> "" Then
recipients = recipients & cell.Value & ";"
End If
Next cell

' メールの設定