• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

copy cell colored with yellow

Hello All,

Kindly help me for the below requirement

i have data in 2 Sheets, on sheet1 i have country names with value and filled cell with Yellow
on sheet2 i have country names, so i want to copy values from the sheet1 for the particular country names which has filled cell with Yellow.

Attached excel for your reference.
 

Attachments

Kenneth Hobson

Active Member
Code:
Sub Main()
    Dim u As Range, f As Range, c As Range, nr As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    
    Set ws1 = Worksheets(1)
    Set ws2 = Worksheets(2)
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    With Application.FindFormat
        .Clear
        .Interior.Color = vbYellow
    End With
    
    With ws2
        .[A1] = "Country"
        .[B1] = "Values"
        nr = 2
        For Each c In ws1.[A1].CurrentRegion.Columns
            Set f = c.Find("", c.Cells(1), searchformat:=True)
            Set u = c.Cells(1)
            If Not f Is Nothing Then Set u = Union(u, f)
            u.Copy
            .Cells(nr, "A").PasteSpecial Transpose:=True
            nr = nr + 1
        Next c
    End With
    
    Application.CutCopyMode = False
    Application.FindFormat.Clear
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationManual
End Sub
 
Top