如何通过VBA实现双击指定列单元格复制值到新工作表指定单元格？

我来帮你搞定这个问题！你当前的代码已经成功识别了双击B3:B45范围的操作，也取消了默认的双击编辑行为，但确实缺少把单元格值复制到Dashboard工作表指定位置的核心步骤。下面是完善后的方案：

优化后的完整代码 #

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' 校验双击的是B3:B45范围内的单个单元格（避免多选触发）
    If Not Intersect(Target, Me.Range("B3:B45")) Is Nothing And Target.Cells.Count = 1 Then
        Cancel = True ' 取消默认的双击进入编辑模式
        
        ' 将双击单元格的值复制到Dashboard工作表的指定单元格，这里示例用A1，你可以改成需要的位置
        Worksheets("Dashboard").Range("A1").Value = Target.Value
        
        ' 如果你需要切换到Dashboard工作表并选中目标单元格（可选操作）
        ' Worksheets("Dashboard").Activate
        ' Worksheets("Dashboard").Range("A1").Select
    End If
End Sub

关键细节说明 #

• 范围校验升级：新增Target.Cells.Count = 1是为了防止用户多选单元格后双击触发，避免出现意外错误。
• 高效赋值方式：直接通过.Value赋值比用Copy/Paste更快，还不会干扰剪贴板里的内容。
• 自定义目标位置：把代码里的Range("A1")改成你实际需要的单元格，比如Range("C5")或者其他合法的单元格引用。
• 避免不必要的激活：原代码里的Activate其实不是必须的，直接通过工作表对象引用单元格就能完成赋值；如果不需要切换到Dashboard工作表，可以直接删掉注释里的那两行代码。

额外扩展：动态追加记录 #

如果你的需求是每次双击都把I.D.值追加到Dashboard的某一列末尾（比如记录操作历史），可以用这段代码替代赋值部分：

' 找到Dashboard工作表A列最后一个非空单元格的下一行
Dim targetRow As Long
targetRow = Worksheets("Dashboard").Cells(Worksheets("Dashboard").Rows.Count, "A").End(xlUp).Row + 1
Worksheets("Dashboard").Cells(targetRow, "A").Value = Target.Value

内容的提问来源于stack exchange，提问作者a_js12