需要根据所选的下拉菜单将新信息复制到另外两个工作表之一

Question

我有 3 个作品sheet被 3 个不同的人使用。 Sheet 如果选择“Res”，“Builder Contact”需要输入 sheet “Res Jobs”，如果选择“Comm”，则需要输入“Comm Jobs”。正在复制的信息不会转到同一列（例如，“Builder Contact”的第 1、10、2、4、5 列将分别为“Res Jobs”的第 1、2、3、7、8 列）。

我还需要在从“Builder Contact”Sheet 的下拉菜单中选择“Res”或“Comm”时自动更新它。我当前的代码目前可以做到这一点，但我每次都必须点击运行并且由于循环它会重复所有内容。但循环是我目前如何获得“x”值我需要找到哪一行来复制所有信息。

Sub Res_Comm()
    Sheets("Builder Contact").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 2 To FinalRow
        ' Decide if to copy based on column K (column with the drop down menu to select "Res" or "Comm")
        ThisValue = Cells(x, 11).Value
        If ThisValue = "Res" Then
            Cells(x, 1).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 10).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 2).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 2).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 3).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 4).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 7).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 5).Copy
            Sheets("Res Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 8).Select
            ActiveSheet.Paste
            ' This column is asking for the source, which in this case would be the name of the user for "Builder Contact"
            Cells(NextRow, 6).Value = "Dan"
            
            
            
        ElseIf ThisValue = "Comm" Then
            Cells(x, 1).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 10).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 3).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 2).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 4).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 4).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 8).Select
            ActiveSheet.Paste
            Sheets("Builder Contact").Select
            
            Cells(x, 5).Copy
            Sheets("Comm Jobs").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(NextRow, 9).Select
            ActiveSheet.Paste
            
            Cells(NextRow, 7).Value = "Dan"
        End If
    Next x
End Sub

[Builder 联系人][1][Res Jobs][2]

它还不允许我直接添加照片，但希望链接有效。 [1]: https://i.stack.imgur.com/ynDvD.png [2]: https://i.stack.imgur.com/1bokm.png

Answer 1

听起来您希望用户从下拉列表中进行选择，然后运行您提供的代码。如果是这样，您想在工作sheet 上放置一个“form-control comboxbox”。您可以在功能区的开发人员选项卡上找到它。

将组合框放在 sheet 上后，right-click 并选择“格式控制”

这将允许您配置控件。在“输入范围”下，select 您希望在可能性列表中显示的值的范围。在“单元格 link”下，将单元格放在您希望值所在的位置。在该单元格中，您将获得一个数字，指示哪个项目是 selected。更改您的代码以根据该数字而不是 res/comm.

采取不同的行动

最后，right-click组合框并选择“分配宏”以在用户做出选择时选择您想要运行的宏。

Answer 2

您的用户似乎在 K 列中输入了“Res”或“Comm”。下面的代码应将“Builder Contact”sheet 相应列中的值写入相应列“Res Jobs”或“Comm Jobs”。您需要将此代码放入“Builder Contact”sheet 的模块中。为此 double-click“Microsoft Excel 对象”下的“Builder Contact”，如此处所示。

然后粘贴此代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim s As Worksheet
    Dim source_columns As Variant
    Dim dest_columns As Variant
    Dim next_row As Long
    Dim x As Long
    
    If Target.Column = 11 Then
        If Target.Value = "Res" Then
            Set s = Sheets("Res Jobs")
            dest_columns = Array(1, 2, 3, 7, 8)
        ElseIf Target.Value = "Comm" Then
            Set s = Sheets("Comm Jobs")
            dest_columns = Array(1, 3, 4, 8, 9)
        Else
            Exit Sub
        End If
        
        source_columns = Array(1, 10, 2, 4, 5)
        
        next_row = s.Cells(s.Rows.Count, 1).End(xlUp).Row + 1
        
        For x = 0 To UBound(source_columns)
             s.Cells(next_row, dest_columns(x)).Value = Cells(Target.Row, source_columns(x))
        Next

        s.Cells(next_row, 6).Value = "Dan"
        
    End If

End Sub

需要根据所选的下拉菜单将新信息复制到另外两个工作表之一

Need to copy new information to one of two other worksheets based on the selected dropdown menu

excel

vba

copy-paste

auto-update