简体   繁体   English

如何完全限定要从Sheet1复制并粘贴到Sheet2的范围?

[英]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.

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