Concatenate values in columns based on headers

Hello.

I am trying to create a macro that will join together cells in the same row IF their headers match a list I input. If possible, I would also like this macro to write the results to a separate workbook on a shared drive.

Any ideas?

Thanks to all!

Before and After workbook attached. If possible, I would also like the macro to spit out the results in a new workbook, with the tab named "Data."

The results need to follow the logic:

First column remains the same
Second column remains the same
Third column takes on a new header name
In third column, if cell in column B includes Yellows, then group cells in columns C, D, and F together and add "Yellow" to end
In third column, if cell in column B includes Greens, then group cells in columns D and G together and add "Green" to end
In third column, if cell in column B includes Blues, then group cells in columns G, E, and F together (order is important) and add "Blue" to end
In third column, if cell in column B includes Reds, then group cells in columns C and F together and add "Red" to end
In third column, if cell in column B includes Oranges, then group cells in columns C and G together and add "Orange" to end

Thanks!

According to your attachment a beginner starter demonstration to paste to the source worksheet module :

PHP Code: 

Sub Demo1()
    Dim R&, S$, V
        Application.ScreenUpdating = False
        Workbooks.Add.Worksheets(1).Name = "Data"
        Me.UsedRange.Columns("A:B").Copy ActiveSheet.[A1]
    For R = 2 To Me.UsedRange.Rows.Count
        S = Split(Cells(R, 2).Value2, "/")(0)
        If S Like "*s" Then S = Left(S, Len(S) - 1)
    Select Case S
           Case "Blue":     V = [{7,5,6}]
           Case "Green":    V = [{4,7}]
           Case "Orange":   V = [{3,7}]
           Case "Red":      V = [{3,6}]
           Case "Yellow":   V = [{3,4,6}]
           Case Else:       V = ""
    End Select
        If IsArray(V) Then ActiveSheet.Cells(R, 3).Value2 = Join(Application.Index(Rows(R), , V)) & " " & S
    Next
        ActiveSheet.UsedRange.Columns("B:C").AutoFit
        Application.ScreenUpdating = True
End Sub 


Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

Thank you. This helps. Can we make me adjustments that are in the new attachment?