繁体   English   中英

如果另一列等于值,将单元格从一列复制到剪贴板的宏

[英]Macro to Copy Cells from one Column to the Clipboard if Another Column Equals Value

我有大量的联系人,我想要一个宏,如果将其电子邮件地址(列J)复制到剪贴板,则将其复制到剪贴板(列C中的=“ a”)。

联系人列表不断进行编辑,其中一些被删除,而另一些则被添加。 我将数据信息的上方和下方的行命名为函数引用,该行与我的其他宏配合得很好。

Sub CopySelected()
Dim oData As New DataObject 
oData.SetText Text:=Empty 'Clear
oData.PutInClipboard
With Worksheets("Master")
    For Each Cell In Range(.Cells(.Range("BorderFirstRow").Row + 1, "C"), _
                .Cells(.Range("BorderLastRow").Row - 1, "C"))
        If Cell.Value = "a" Then

                .PutInClipboard
        End If
    End With
End Sub

如果列C =“ A”,宏需要如何复制电子邮件地址列J?

这是一个包含虚拟数据的虚拟工作表。 希望它像你一样: 在此处输入图片说明 下面的代码对我来说没有错误:

Sub CopyToClip()

Dim ClipB As New DataObject
Dim RangeToConsider As Range
Dim strAddresses As String

    ' set the range
    ' here just set the relevant range from the C column
        Set RangeToConsider = Range("E4:E7") ' in my case!
For Each cell In RangeToConsider
    If cell.Value = "a" Or cell.Value = "A" Then
        If Not (Trim(cell.Offset(0, -2).Value) = "") Then
           strAddresses = strAddresses & "; " & cell.Offset(0, -2).Value
        end if
    End If
Next
strAddresses = Mid(strAddresses, 2) ' delete the first semicolon
strAddresses = strAddresses & ";" ' add a semicolon at the end
strAddresses = Trim(strAddresses) ' delete spaces if any
Debug.Print strAddresses
ClipB.SetText strAddresses
ClipB.PutInClipboard
Debug.Print ClipB.GetText()
End Sub

因此,运行该过程后,我可以粘贴“名称; AnotherName;”

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM