下拉项功能

pauwelwang

描述：

1.本工作簿共5个工作表，分别是：未检原因，闸口验箱JL，冻柜电王JL，西港修箱JL，外场JL；5 个工作表结构相同；

2.“未检原因”工作表中，A1B1合并单元格中有5个下拉选项，分别是：闸口验箱，冻柜电王，西港修箱，外场，综合筛查；

要实现如下要求：

1.当下拉项分别为“闸口验箱，冻柜电王，西港修箱，外场”4个项时，分别将对应4个工作表“闸口验箱JL，冻柜电王JL，西港修箱JL，外场JL”中D列人员姓名分别复制到“未检原因”工作表中B列中，且所制的这些姓名不可以删除，修改等。

例如，当下拉项为“闸口验箱”，则“卢国新、叶清泉......黄巧玉”被全部复制到“未检原因”B3开始的单元格中，不可编辑；

当下拉项为“冻柜电王”，则“张智健、阳睿虎....钟青辉”被全部复制到“未检原因”B3开始的单元格中，不可编辑；

如此类推；

2.当下拉项为“综合筛查”项时，“未检原因”工作表B列的B3以下单元格为可编辑状态，即可复制，粘贴等；

问题：要如何才能实现上述功能？烦请各位大师指教！附上工作簿。

pauwelwang

请教各位大师帮忙

pauwelwang

这个问题太简单，还是太难？？？

请求各位大师帮助

哥儿-

这个得VBA，录制的宏，改了一下
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, arr
    If Target.Address(0, 0) <> "A1" Then Exit Sub
    If Target.Value = "综合筛查" Then
        Sheet1.Unprotect Password:="123456"
    Else
        With Sheets(Target.Value & "JL")
            Set rng = .Cells(Rows.Count, 4).End(3)
            arr = .Range(.[d2], rng)
        End With
        With Sheet1
            .Unprotect Password:="123456"
            .[B3:B1000].ClearContents
            .[b3].Resize(UBound(arr)) = arr
            .[B3:B1000].Locked = True
            .Protect Password:="123456", DrawingObjects:=True, Contents:=True
        End With
    End If
End Sub