Excel VBA代码，用于将具有颜色的单元格复制到同一工作表中的不同单元格

我有一个问题，那就是将包含颜色和某些值的单元格复制到一个范围内。下面代码的问题是它复制粘贴整个范围，而不是红色的范围

Sub testing()

Dim Myrange As Range
Dim Mycell As Range
Dim Target As Range

Set Myrange = Sheet1.Range("A3:A15")
Set Target = Sheet1.Range("B3:B15")

For Each Mycell In Myrange
    If Mycell.Interior.ColorIndex = 3 Then
       Mycell.Copy Target
    End If
Next Mycell

End Sub

---

我的预期结果是复制目标范围内仅包含红色的粘贴单元格。（如果A3单元格为红色，我希望B3单元格也为红色。但我不希望目标单元格的整个范围变为红色）

如果计划偏移1，则不需要

目标范围：

Sub TestMe()

    Dim myRange As Range
    Dim myCell As Range

    Set myRange = Worksheets(1).Range("A3:A15")

    For Each myCell In myRange
        If myCell.Interior.ColorIndex = 3 Then
           myCell.Copy myCell.Offset(0, 1)
        End If
    Next myCell

End Sub

或者，如果出于任何原因需要使用
目标
，在这种情况下，按索引循环就可以了，因为单元格位于一行：

Sub TestMe()

    Dim myRange As Range
    Dim myCell As Range

    Set myRange = Worksheets(1).Range("A3:A15")
    Set target = myRange.Offset(columnoffset:=1)

    Dim i As Long
    For i = 1 To myRange.Cells.Count
        If myRange.Cells(i).Interior.ColorIndex = 3 Then
            myRange.Cells(i).Copy target.Cells(i)
        End If
    Next i

End Sub

如果计划偏移1，则不需要
目标
范围：

Sub TestMe()

    Dim myRange As Range
    Dim myCell As Range

    Set myRange = Worksheets(1).Range("A3:A15")

    For Each myCell In myRange
        If myCell.Interior.ColorIndex = 3 Then
           myCell.Copy myCell.Offset(0, 1)
        End If
    Next myCell

End Sub

或者，如果出于任何原因需要使用
目标
，在这种情况下，按索引循环就可以了，因为单元格位于一行：

Sub TestMe()

    Dim myRange As Range
    Dim myCell As Range

    Set myRange = Worksheets(1).Range("A3:A15")
    Set target = myRange.Offset(columnoffset:=1)

    Dim i As Long
    For i = 1 To myRange.Cells.Count
        If myRange.Cells(i).Interior.ColorIndex = 3 Then
            myRange.Cells(i).Copy target.Cells(i)
        End If
    Next i

End Sub

Mycell.Copy Mycell.offset（，1）
Mycell.Copy Sheet1.Range（“B”和Mycell.row）
Mycell.Copy Mycell.offset（，1）
Mycell.Copy Sheet1.Range（“B”和Mycell.row）