点击单元格自动复制到粘贴板：代码优化

gareth

以下代码是点击A1单元格时，将A1单元格的内容复制到粘贴板，有什么办法可以改为：点击任意单元格，都可以将所点击的单元格复制到粘贴板？求指点，谢谢！
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then Call 复制A
End Sub

Sub 复制A()
'Dim d As Object
On Error Resume Next
Dim MyData As DataObject
Set MyData = New DataObject
MyData.SetText ""

MyData.SetText Range("A" & 1).Value
MyData.PutInClipboard
End Sub

wxxydl

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call 复制A
End Sub

Sub 复制A()
'Dim d As Object
On Error Resume Next
Dim MyData As DataObject
Set MyData = New DataObject
MyData.SetText ""

MyData.SetText activecell.Value
MyData.PutInClipboard
End Sub
这样可以吧

wxxydl

把附件发来  我可以试下

gareth

wxxydl 发表于 2017-12-26 21:52
把附件发来  我可以试下

点击复制.rar (11.39 KB, 下载次数: 14)

2017-12-26 22:01 上传

点击文件名下载附件

谢谢您的关注，提示出错未定义哦

gareth

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
        Target.Copy
End Sub

这代码只可惜粘贴出来是图片，不是文本

rivet_nuts

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
        Target.Copy
End Sub

rivet_nuts

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
        Target.Copy
        Msgbox Target.Value         '这句用来理解的，理解好了就可以删了。
End Sub

这段代码要放在工作表事件中。

gareth

rivet_nuts 发表于 2017-12-26 22:57
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub ...

这个复制方式达不到我要求呀，它粘贴出来不行，是图片

gareth

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
    [AV1] = Target.Value
Call 复制AV
End Sub


Sub 复制AV()
On Error Resume Next
Dim MyData As DataObject
Set MyData = New DataObject
MyData.SetText ""

MyData.SetText Range("AV" & 1).Value
MyData.PutInClipboard
End Sub
搞拈！

wxxydl

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call 复制A
End Sub

Sub 复制A()
'Dim d As Object
On Error Resume Next
Dim MyData As DataObject
Set MyData = New DataObject
MyData.SetText ""

MyData.SetText activecell.Value
MyData.PutInClipboard
End Sub
这样能行通   只是按照下图引用