![](/img/trans.png)
[英]Find cells within a range if one cell equals a criteria copy its value to another column
[英]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.