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

Question

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

当从“Builder Contact”表的下拉菜单中选择“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 Contact][1][Res Jobs][2]

它还不允许我直接添加照片，但希望链接可以工作。 [1]: https://i.sstatic.net/ynDvD.png [2]: https://i.sstatic.net/1bokm.png

Answer 1

似乎您的用户在K列中输入“ res”或“ comm”。 Comm Jobs”。您需要将此代码放在“建筑商联系人”表的模块中。在“ Microsoft Excel对象”下进行双击“建筑商联系”，如下所示。

然后粘贴在此代码中：

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

Answer 2

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

Once you place the combobox on the sheet, right-click it and choose "Format Control"

This will allow you to configure the control.在“输入范围”下，选择要显示在可能性列表中的值的范围。在“小区链接”下，将单元格放置在您希望该值的位置。在该单元格中，您将获得一个指示选择哪个项目的数字。根据该数字而不是RES/COMM更改代码以不同。

最后，右键单击ComboBox，然后选择“分配宏”以选择您要选择的宏。