macro copy and paste in specific cells.

[Alidad]

Hi, I’m having trouble to figure out how to write that code. Let say that I have ten values on column “A” and each cell in column A have different values between column B to F of each row, and I want to copy each value between B to F to the DIFFERENTS CELL VALUE of any columns.
Currently, the codes you see, what does do is they find match value in column A and then copy same row and paste over another sheet.

see sample sheet:

A B C D
1 Blue 22 32 42
2 Green 45 65 75
3 Yellow 98 99 100
4 Red 55 65 75

see the real code

Sub Test()
 
Dim Cell As Range
 
With Sheets(1)
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlDown).Row)
        If Cell.Value = "Yellow" Then
             .Rows(Cell.Row).Copy Destination:=Sheets(2).Rows(Cell.Row)
        End If
    Next Cell
End With
 
End Sub

Let say I look for Yellow in column A, and I want copy B3 value of 98 to sheet2 C5
Copy C3 value of 99 to sheet2 K4
Copy D3 copy value of 100 to sheet B5

How can I write that code!

many thanks.
AM

 

[DanteAmor]

Try this

Sub Test2()
    Set sh1 = Sheets("Sheet1")  'source
    Set sh2 = Sheets("Sheet2")  'Destination
    
    Set b = sh1.Columns("A").Find("Yellow", LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        sh2.Range("C5").Value = sh1.Cells(b.Row, "B").Value
        sh2.Range("K4").Value = sh1.Cells(b.Row, "C").Value
        sh2.Range("B5").Value = sh1.Cells(b.Row, "D").Value
        MsgBox "Copied Data "
    Else
        MsgBox "The data does not exist"
    End If
End Sub