简体   繁体   中英

VBA Code to Copy Cells with Color to different cells in same sheet

I have an issue which is to copy cells that contain a color and some value in it to a range. The issue with the below code is that it copy pastes the entire range and not the ones that are in red color.

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

My expected result is to copy paste cells that contain only red color in the target range. (If A3 cell is red color I want B3 cell to be red color as well. But what I dont want is the entire range of the target cells to turn red)

The target range is not needed, if you are planning to offset by 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

Or if you need to use the target for whatever reason, looping by index would be ok in this case, as the cells are in 1 row:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

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