excel，合并两个vba工作表更改事件？

我试图运行多个工作表更改事件，但当宏1也存在时，我的第二个宏似乎无法工作。然而，宏1确实起作用

我试着将两者结合起来，但仍然没有成功，谁能告诉我哪里出了问题

宏1

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = Range("CA8").Column Then

 Dim Email_Subject, Email_Send_From, Email_Send_To, _
 Email_Cc, Email_Bcc, Email_Body As String
 Dim Mail_Object, Mail_Single As Variant
 Email_Subject = "New Supplier Set-Up Confirmation"
 Email_Send_From = "purchasing@hewden.co.uk"
 Email_Send_To = Range("AF" & ActiveCell.Row)
 Email_Cc = "purchasing@hewden.co.uk"
 Email_Bcc = ""
 Email_Body = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & "This is to confirm that the following supplier was set-up on AX, on " & Range("CB" & ActiveCell.Row) & "." & vbNewLine & vbNewLine & "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & "Kind Regards," & vbNewLine & "The Purchasing Team"
 On Error GoTo debugs
 Set Mail_Object = CreateObject("Outlook.Application")
 Set Mail_Single = Mail_Object.CreateItem(0)
 With Mail_Single
 .Subject = "New Supplier Set-Up Confirmation"
 .to = Range("AF" & ActiveCell.Row)
 .CC = "purchasing@hewden.co.uk"
 .BCC = ""
 .Body = Email_Body
 .Send
 End With
debugs:
 If Err.Description <> "" Then MsgBox Err.Description



End If
End If
End Sub

以下是我尝试过的：

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = Range("CA8").Column Then

     Dim Email_Subject, Email_Send_From, Email_Send_To, _
     Email_Cc, Email_Bcc, Email_Body As String
     Dim Mail_Object, Mail_Single As Variant
     Email_Subject = "New Supplier Set-Up Confirmation"
     Email_Send_From = "purchasing@hewden.co.uk"
     Email_Send_To = Range("AF" & ActiveCell.Row)
     Email_Cc = "purchasing@hewden.co.uk"
     Email_Bcc = ""
     Email_Body = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & "This is to confirm that the following supplier was set-up on AX, on " & Range("CB" & ActiveCell.Row) & "." & vbNewLine & vbNewLine & "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & "Kind Regards," & vbNewLine & "The Purchasing Team"
     On Error GoTo debugs
     Set Mail_Object = CreateObject("Outlook.Application")
     Set Mail_Single = Mail_Object.CreateItem(0)
     With Mail_Single
     .Subject = "New Supplier Set-Up Confirmation"
     .to = Range("AF" & ActiveCell.Row)
     .CC = "purchasing@hewden.co.uk"
     .BCC = ""
     .Body = Email_Body
     .Send
     End With
debugs:
     If Err.Description <> "" Then MsgBox Err.Description


    If ActiveCell.Address(False, False) = "CD8" Then

        Dim OutApp As Object
        Dim OutMail As Object
        Dim strbody As String

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        strbody = "Dear Sumayra," & vbNewLine & vbNewLine & _
                  "Please would you complete the bank details set-up for the following supplier." & vbNewLine & vbNewLine & _
                  "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & _
                  "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & _
                  "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & _
                  "Kind Regards," & vbNewLine & _
                  "Automated Purchasing Email"

        On Error Resume Next
        With OutMail
            .to = "sumayra.idoo@hewden.co.uk"
            .CC = "purchasing@hewden.co.uk"
            .BCC = ""
            .Subject = "New Supplier Bank Details Set-Up"
            .Body = strbody
            'You can add a file like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing



    End If


    End If
    End Sub

Private子工作表\u更改（ByVal目标作为范围）
如果Target.Column=范围（“CA8”）.Column，则
Dim Email_主题、Email_Send_From、Email_Send_To、_
电子邮件抄送、电子邮件密件抄送、电子邮件正文为字符串
Dim Mail_对象，Mail_单个作为变量
电子邮件\u Subject=“新供应商设置确认”
电子邮件\u发送\u发件人=”purchasing@hewden.co.uk"
Email\u Send\u To=Range（“AF”和ActiveCell.Row）
电子邮件_Cc=”purchasing@hewden.co.uk"
电子邮件_Bcc=“”
Email_Body=“亲爱的”&Range（“AE”&ActiveCell.Row）&“，&vbNewLine&vbNewLine&”这是为了确认以下供应商是在AX上、在“&Range（“CB”&ActiveCell.Row）&“&vbNewLine&vbNewLine&supplier Name:”&Range（“B”&ActiveCell.Row）&vbNewLine&“供应商编号：”&Range（“F”&ActiveCell.Row）&vbNewLine&“供应商状态：”&Range（“D”&ActiveCell.Row）&vbNewLine&vbNewLine&“问候”&vbNewLine&“采购团队”
关于错误转到调试
设置Mail\u Object=CreateObject（“Outlook.Application”）
设置Mail\u Single=Mail\u Object.CreateItem（0）
单程邮寄
.Subject=“新供应商设置确认”
.to=范围（“AF”和ActiveCell.Row）
.CC=”purchasing@hewden.co.uk"
.BCC=“”
.Body=电子邮件\正文
邮寄
以
调试：
如果错误描述为“”，则MsgBox错误描述为“”
如果ActiveCell.Address（False，False）=“CD8”，则
Dim OutApp作为对象
将邮件变暗为对象
像弦一样暗的链子
Set-OutApp=CreateObject（“Outlook.Application”）
Set-OutMail=OutApp.CreateItem（0）
strbody=“亲爱的Sumayra，”&vbNewLine&vbNewLine&_
“请完成以下供应商的银行详细信息设置。”&vbNewLine&vbNewLine&_
“供应商名称：”&范围（“B”&ActiveCell.Row）&vbNewLine&_
“供应商编号：”&Range（“F”&ActiveCell.Row）&vbNewLine&_
“供应商状态：”&范围（“D”&ActiveCell.Row）&vbNewLine&vbNewLine&_
“亲切问候”&vbNewLine&_
“自动采购电子邮件”
出错时继续下一步
发邮件
.to=“sumayra。idoo@hewden.co.uk"
.CC=”purchasing@hewden.co.uk"
.BCC=“”
.Subject=“新供应商银行详细信息设置”
.车身=车身
'您可以添加这样的文件
'.Attachments.Add（“C:\test.txt”）
.Send'或use.Display
以
错误转到0
发送邮件=无
设置应用程序=无
如果结束
如果结束
端接头

我不能肯定没有看到您的工作表，但我希望

如果ActiveCell.Address（False，False）=“CD8“

导致问题

ActiveCell

返回更改后处于活动状态的范围。例如，当您更改A1单元格并按enter键时，将触发更改事件，ActiveCell将为A2。要检查它是否为A1，您需要使用事件提供的目标。

这是否有效

Private Sub Worksheet_Change(ByVal Target As Range)
    Macro1 Target
    Macro2 Target
end sub

Private Sub Macro1(ByVal Target As Range)
    If Target.Column = Range("CA8").Column Then

 Dim Email_Subject, Email_Send_From, Email_Send_To, _
 Email_Cc, Email_Bcc, Email_Body As String
 Dim Mail_Object, Mail_Single As Variant
 Email_Subject = "New Supplier Set-Up Confirmation"
 Email_Send_From = "purchasing@hewden.co.uk"
 Email_Send_To = Range("AF" & ActiveCell.Row)
 Email_Cc = "purchasing@hewden.co.uk"
 Email_Bcc = ""
 Email_Body = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & "This is to confirm that the following supplier was set-up on AX, on " & Range("CB" & ActiveCell.Row) & "." & vbNewLine & vbNewLine & "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & "Kind Regards," & vbNewLine & "The Purchasing Team"
 On Error GoTo debugs
 Set Mail_Object = CreateObject("Outlook.Application")
 Set Mail_Single = Mail_Object.CreateItem(0)
 With Mail_Single
 .Subject = "New Supplier Set-Up Confirmation"
 .to = Range("AF" & ActiveCell.Row)
 .CC = "purchasing@hewden.co.uk"
 .BCC = ""
 .Body = Email_Body
 .Send
 End With
debugs:
 If Err.Description <> "" Then MsgBox Err.Description



End If
End If
End Sub


Private Sub Macro2(ByVal Target As Range)
 If ActiveCell.Address(False, False) = "CD8" Then

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear Sumayra," & vbNewLine & vbNewLine & _
              "Please would you complete the bank details set-up for the following supplier." & vbNewLine & vbNewLine & _
              "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & _
              "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & _
              "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & _
              "Kind Regards," & vbNewLine & _
              "Automated Purchasing Email"

    On Error Resume Next
    With OutMail
        .to = "sumayra.idoo@hewden.co.uk"
        .CC = "purchasing@hewden.co.uk"
        .BCC = ""
        .Subject = "New Supplier Bank Details Set-Up"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing


End If
End Sub

Private子工作表\u更改（ByVal目标作为范围）
宏1目标
Macro2靶
端接头
专用子宏1（ByVal目标作为范围）
如果Target.Column=范围（“CA8”）.Column，则
Dim Email_主题、Email_Send_From、Email_Send_To、_
电子邮件抄送、电子邮件密件抄送、电子邮件正文为字符串
Dim Mail_对象，Mail_单个作为变量
电子邮件\u Subject=“新供应商设置确认”
电子邮件\u发送\u发件人=”purchasing@hewden.co.uk"
Email\u Send\u To=Range（“AF”和ActiveCell.Row）
电子邮件_Cc=”purchasing@hewden.co.uk"
电子邮件_Bcc=“”
Email_Body=“亲爱的”&Range（“AE”&ActiveCell.Row）&“，&vbNewLine&vbNewLine&”这是为了确认以下供应商是在AX上、在“&Range（“CB”&ActiveCell.Row）&“&vbNewLine&vbNewLine&supplier Name:”&Range（“B”&ActiveCell.Row）&vbNewLine&“供应商编号：”&Range（“F”&ActiveCell.Row）&vbNewLine&“供应商状态：”&Range（“D”&ActiveCell.Row）&vbNewLine&vbNewLine&“问候”&vbNewLine&“采购团队”
关于错误转到调试
设置Mail\u Object=CreateObject（“Outlook.Application”）
设置Mail\u Single=Mail\u Object.CreateItem（0）
单程邮寄
.Subject=“新供应商设置确认”
.to=范围（“AF”和ActiveCell.Row）
.CC=”purchasing@hewden.co.uk"
.BCC=“”
.Body=电子邮件\正文
邮寄
以
调试：
如果错误描述为“”，则MsgBox错误描述为“”
如果结束
如果结束
端接头
专用子宏2（ByVal目标作为范围）
如果ActiveCell.Address（False，False）=“CD8”，则
Dim OutApp作为对象
将邮件变暗为对象
像弦一样暗的链子
Set-OutApp=CreateObject（“Outlook.Application”）
Set-OutMail=OutApp.CreateItem（0）
strbody=“亲爱的Sumayra，”&vbNewLine&vbNewLine&_
“请完成以下供应商的银行详细信息设置。”&vbNewLine&vbNewLine&_
“供应商名称：”&范围（“B”&ActiveCell.Row）&vbNewLine&_
“供应商编号：”&Range（“F”&ActiveCell.Row）&vbNewLine&_
“供应商状态：”&范围（“D”&ActiveCell.Row）&vbNewLine&vbNewLine&_
“亲切问候”&vbNewLine&_
“自动采购电子邮件”
出错时继续下一步
发邮件
.to=“sumayra。idoo@hewden.co.uk"
.CC=”purchasing@hewden.co.uk"
.BCC=“”
.Subject=“新供应商银行详细信息设置”
.车身=车身
'您可以添加这样的文件
'.Attachments.Add（“C:\test.txt”）
.Send'或use.Display
以
Private Sub Worksheet_Change(ByVal Target As Range)
    Macro1 Target
    Macro2 Target
end sub

Private Sub Macro1(ByVal Target As Range)
    If Target.Column = Range("CA8").Column Then

 Dim Email_Subject, Email_Send_From, Email_Send_To, _
 Email_Cc, Email_Bcc, Email_Body As String
 Dim Mail_Object, Mail_Single As Variant
 Email_Subject = "New Supplier Set-Up Confirmation"
 Email_Send_From = "purchasing@hewden.co.uk"
 Email_Send_To = Range("AF" & ActiveCell.Row)
 Email_Cc = "purchasing@hewden.co.uk"
 Email_Bcc = ""
 Email_Body = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & "This is to confirm that the following supplier was set-up on AX, on " & Range("CB" & ActiveCell.Row) & "." & vbNewLine & vbNewLine & "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & "Kind Regards," & vbNewLine & "The Purchasing Team"
 On Error GoTo debugs
 Set Mail_Object = CreateObject("Outlook.Application")
 Set Mail_Single = Mail_Object.CreateItem(0)
 With Mail_Single
 .Subject = "New Supplier Set-Up Confirmation"
 .to = Range("AF" & ActiveCell.Row)
 .CC = "purchasing@hewden.co.uk"
 .BCC = ""
 .Body = Email_Body
 .Send
 End With
debugs:
 If Err.Description <> "" Then MsgBox Err.Description



End If
End If
End Sub


Private Sub Macro2(ByVal Target As Range)
 If ActiveCell.Address(False, False) = "CD8" Then

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear Sumayra," & vbNewLine & vbNewLine & _
              "Please would you complete the bank details set-up for the following supplier." & vbNewLine & vbNewLine & _
              "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & _
              "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & _
              "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & _
              "Kind Regards," & vbNewLine & _
              "Automated Purchasing Email"

    On Error Resume Next
    With OutMail
        .to = "sumayra.idoo@hewden.co.uk"
        .CC = "purchasing@hewden.co.uk"
        .BCC = ""
        .Subject = "New Supplier Bank Details Set-Up"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing


End If
End Sub