[英]How to fully qualify a range to copy from Sheet1 and paste to Sheet2?
I want to run a script to find cells highlighted yellow, on Sheet1 and if yellow, copy/paste to Sheet2. 我想运行一个脚本来查找在Sheet1上突出显示为黄色的单元格,如果是黄色,则将其复制/粘贴到Sheet2。 The code below seems like it should work, but it's failing on this line.
下面的代码似乎应该工作,但是在此行失败。
rc.Copy rd
Basically, I would like to concatenate values in Columns 2, 3, and 17, on Sheet1, and copy/paste everything to Sheet2. 基本上,我想在Sheet1的第2、3和17列中连接值,并将所有内容复制/粘贴到Sheet2。 I'm guessing that I'm missing some kind of Worksheet reference, but I don't know for sure, and so far nothing has worked for me.
我猜想我缺少某种形式的工作表参考,但是我不确定,到目前为止,没有任何事情对我有用。 But...I think this is pretty close!!
但是...我认为这非常接近! Any help is appreciated!
任何帮助表示赞赏!
Sub ColorCopier()
Dim i As Long
Dim j As Long
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Version Control")
LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1
'k = 1
Set rc = Sheets("Cobrand Tasklist").UsedRange
For i = 1 To rc.Rows.Count
For j = 1 To rc.Columns.Count
If Cells(i, j).Interior.ColorIndex = 6 Then
If j = 2 Then
Set rc = Cells(i, j)
Set rd = Sheets("Version Control").Cells(LRow, 4)
rc = "Task #" & rc
rc.Copy rd
End If
If j = 3 Then
Set rc = Cells(i, j)
Set rd = Sheets("Version Control").Cells(LRow, 4)
rc = "Task Title " & rc
rc.Copy rd
End If
If j = 17 Then
Set rc = Cells(i, j)
Set rd = Sheets("Version Control").Cells(LRow, 4)
rc = "Task Description " & rc
rc.Copy rd
End If
LRow = LRow + 1
End If
Next
Next
End Sub
You really could condense the code down to stop repeating the same code. 您确实可以将代码压缩下来以停止重复相同的代码。 But , I left it the way you have done it to illustrate a different way of doing what I think you are trying to do.
但是,我按您做的方式保留了它,以说明另一种我认为您尝试做的事情。
Dim i As Long
Dim j As Long
Dim sht As Worksheet
Dim LastRow As Long
Dim rng As Range
Dim str As String
Dim rng As Range
'
Set sht = ThisWorkbook.Worksheets("Version Control")
LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1
'k = 1
Set rc = Sheets("Cobrand Tasklist").UsedRange
For i = 1 To rc.Rows.Count
For j = 1 To rc.Columns.Count
If Cells(i, j).Interior.ColorIndex = 6 Then
If j = 2 Then
Cells(i, j).Value = "Task #" & Cells(i, j).Value
If Not rng Is Nothing Then Set rng = Union(rng, Cells(i, j)) Else Set rng = Cells(i, j)
End If
If j = 3 Then
Cells(i, j).Value = "Task Title " & Cells(i, j).Value
If Not rng Is Nothing Then Set rng = Union(rng, Cells(i, j)) Else Set rng = Cells(i, j)
End If
If j = 17 Then
Cells(i, j).Value = "Task Description " & Cells(i, j).Value
If Not rng Is Nothing Then Set rng = Union(rng, Cells(i, j)) Else Set rng = Cells(i, j)
End If
LRow = LRow + 1
End If
Next
Next
rng.Copy Sheets("Version Control").Cells(LRow, 4)
Doing the copy and paste on one line instead of every time inside the loop will speed up your code enormously. 复制和粘贴而不是每次循环都在一行中进行复制和粘贴,将极大地加快您的代码的速度。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.