Excel VBA通过查找标题发送到电子邮件地址；电邮；并将电子邮件发送到匹配标题下的第一个单元格

我正在寻找发送到特定电子邮件地址的标题“电子邮件”，然后将电子邮件发送到匹配标题下的第一个单元格。电子邮件地址列并不总是相同的，这就是为什么我需要它在匹配后返回下面的单元格（即电子邮件地址所在的位置，例如电子邮件标题ak1电子邮件地址ak2）

[Excel文件示例][1] [1]: https://i.stack.imgur.com/dKybj.png

我想用可以查找标题（第1行）并插入相应电子邮件地址（单单元格，第2行）的内容替换代码中的范围AJ2

---

你应该展示你迄今为止所做的努力。好的问题通常表现出解决问题的努力，提出问题的人有足够的研究和努力。标题是指工作表的第一行吗？你在不同的工作表/工作簿上重复这个吗？@Scinana好的，我更新了我的问题。谢谢你的建议

Range("AJ1").Select
ActiveCell.FormulaR1C1 = "Fund Email"


  'Move the active sheet to a new Workbook
ActiveWindow.SelectedSheets.Copy
ActiveWorkbook.Password = "**********"

ActiveWorkbook.SaveAs 
"\\na\Forrest\Backup.xlsx"
Dim OutApp As Object
Dim OutMail As Object
 Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = Range("AJ2").Value
    .CC = ""
    .BCC = ""
    .Subject = Range("AK2").Value + " -Benefits backup"
    .Body = "Attached is the current month's benefit payment backup for 
check en route to your fund's office."
    .Attachments.Add ActiveWorkbook.FullName
            .send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

ActiveWorkbook.Close

Dim cel as Range
Dim dst as String       ' Destinataire
Dim sbj as String       ' Subject 

Const FEM = "fund email"  
Range("AJ1").Value = FEM 

ActiveWorkbook.Password = "BlahBlah"
ActiveWorkbook.SaveAs   = "\\na\Forrest\Backup.xlsx"

Set cel = Rows(1).Find(FEM)
sbj = cel.Offset(0,1).Value     '  "CBA"
dst = cel.Offset(1,0).Value     '  "Frank.Barone@usa.com"

On Error Resume Next ' Sends the current workbook by mail 
ActiveWorkbook.SendMail dst, sbj & " -Benefits backup - see Attachment."  
' Unfortunately you cannot fill the body of the mail with this method
On Error GoTo 0

' etc ...