Excel 在一个工作表中合并两个或多个专用子表

我想有两个私人分如下（可能更多）在一张纸。 每一个单独工作，但当我有两个，只有第一个工作。你能帮帮我吗

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("f6:G19, j6:m19, f22:G35, j22:j35, L22:M35")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If

    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)



End Sub

及

---

非常感谢您。

事件处理程序有特定的名称，它不会将第二个子系统识别为事件处理程序，它只是认为一个子系统恰好具有与第一个子系统相似的名称。您可以重命名这两个事件，然后创建一个新的事件子项并从中调用它们，或者将它们合并为一个子项

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    dblclick_a target, cancel
    dblclick_b target, cancel
end sub

Private Sub dblclick_a(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("f6:G19, j6:m19, f22:G35, j22:j35, L22:M35")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If

    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)

End Sub

Private Sub dblclick_b(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("h24:h25, h8:h9")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If


    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)
    Sheets("ShoppingCart").Cells(Lastrow + 1, 3).Value = "148H3124"


End Sub

---

两个代码之间的唯一区别是第一行和最后一行代码。非常感谢。把它钉死了：）

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    dblclick_a target, cancel
    dblclick_b target, cancel
end sub

Private Sub dblclick_a(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("f6:G19, j6:m19, f22:G35, j22:j35, L22:M35")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If

    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)

End Sub

Private Sub dblclick_b(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, Me.Range("h24:h25, h8:h9")) Is Nothing Then Exit Sub

    If Not Target.MergeCells Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Else
        If IsEmpty(Target.Cells(1, 1)) Then Exit Sub
    End If


    Cancel = True
    Dim Lastrow As Long
    Lastrow = Sheets("ShoppingCart").Cells(Rows.Count, "C").End(xlUp).Row + 1

    Target.Cells(1, 1).Copy Sheets("ShoppingCart").Cells(Lastrow, 3)
    Sheets("ShoppingCart").Cells(Lastrow + 1, 3).Value = "148H3124"


End Sub