extract data from Excel Columns to an Output sheet

[Pamella]

I have 2 sheet. One is the Source- This contains 1) ID no.s in Column B starting from Cell B3. 2) Colour in Column C and 3) The Amounts I have to retrieve are in Column E.
Then in the Output Sheet, I must paste the ID no. in column A. (in an un-used row), next paste the Amount in the same row. Row 1 in Output sheet contains all the Colours. So the macro would have to find the corresponding colour from source and match it to the one in Output and paste in the correct matching cell.

Column B which contains the Id's some contains blanks because it has multiple colours.

Source sheet would look like this

A B C D E
name ID Colour Amount Status
asda A1 Red 12
cccc 1B Red 76
ddd 2C Red 56
Blue 78
Green 532
Yellow 43
qqq 34V Yellow 566



Outputsheet would look like this...

Red Blue Green Yellow
1A 12
1B 76
2C 56 78 532 43
34V 566

[Bob Phillips]

Public Sub ExtractData()
Dim wsRes As Worksheet
Dim nextrow As Long
Dim lastrow As Long
Dim i As Long

    On Error Resume Next
    Application.DisplayAlerts = False
        Worksheets("Output").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    With ActiveSheet
    
        Set wsRes = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        wsRes.Name = "Output"
        wsRes.Range("A1:E1").Value = Array("Id", "Red", "Blue", "Green", "Yellow")

        nextrow = 1
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lastrow
        
            If Not .Cells(i, "B").Value = vbNullString Then
            
                nextrow = nextrow + 1
                .Cells(i, "B").Copy wsRes.Cells(nextrow, "A")
            End If
            .Cells(i, "E").Copy wsRes.Cells(nextrow, wsRes.Cells(nextrow, wsRes.Columns.Count).End(xlToLeft).Column + 1)
        Next i
    End With
End Sub

[Pamella]

The Output sheet already exists. I cant see where it is pasting in the Output sheet? I require it to find the ID and paste in column A if it doesnt already exist, then add the amount under the correct colour. There will be more than 20 colours so dont want to add them to an array simply find a match. Something like this.

 Set rngFoundCells = wOutput.Rows(1).Find(What:=CStr(strColour), LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)