如何完全限定要從Sheet1復制並粘貼到Sheet2的范圍？

Question

我想運行一個腳本來查找在Sheet1上突出顯示為黃色的單元格，如果是黃色，則將其復制/粘貼到Sheet2。 下面的代碼似乎應該工作，但是在此行失敗。

rc.Copy rd

基本上，我想在Sheet1的第2、3和17列中連接值，並將所有內容復制/粘貼到Sheet2。 我猜想我缺少某種形式的工作表參考，但是我不確定，到目前為止，沒有任何事情對我有用。 但是...我認為這非常接近！ 任何幫助表示贊賞！

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

Answer 1

您確實可以將代碼壓縮下來以停止重復相同的代碼。 但是，我按您做的方式保留了它，以說明另一種我認為您嘗試做的事情。

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)

復制和粘貼而不是每次循環都在一行中進行復制和粘貼，將極大地加快您的代碼的速度。