以下是一个简单的VBA代码，可以实现将WS2的B列中相同的值用同一种颜色标识，不同的值用不同的颜色标识：，将不同颜色的行复制粘贴到新建的excel中的第二行开始粘贴，新建的excel以该颜色的值命名

以下是一个可能的VBA代码实现：

Sub ColorDuplicates()
    Dim ws1 As Worksheet, ws2 As Worksheet, wsNew As Worksheet
    Dim lastRow As Long, i As Long
    Dim dict As Object, key As Variant
    Dim colorIndex As Integer
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1") '修改为实际的工作表名称
    Set ws2 = ThisWorkbook.Worksheets("Sheet2") '修改为实际的工作表名称
    Set dict = CreateObject("Scripting.Dictionary")
    
    lastRow = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
    
    For i = 2 To lastRow
        If Not dict.exists(ws2.Cells(i, "B").Value) Then
            dict(ws2.Cells(i, "B").Value) = colorIndex
            colorIndex = colorIndex + 1
            If colorIndex > 56 Then colorIndex = 2 '循环使用Excel支持的颜色编号
        End If
        ws2.Cells(i, "B").Interior.ColorIndex = dict(ws2.Cells(i, "B").Value)
    Next i
    
    '复制不同颜色的行到新的工作表
    Set wsNew = ThisWorkbook.Worksheets.Add(after:=ws2)
    wsNew.Name = "Color Summary"
    ws1.Rows(1).Copy wsNew.Rows(1)
    i = 2
    For Each key In dict.keys
        If key <> "" Then
            ws1.Rows(1).Copy wsNew.Rows(i)
            ws1.Range("A:A,B:B").AutoFilter Field:=2, Criteria1:=key
            ws1.Range("A2:B" & lastRow).SpecialCells(xlCellTypeVisible).Copy wsNew.Rows(i + 1)
            wsNew.Name = key
            i = i + 2
        End If
    Next key
    
    ws1.Rows(1).AutoFilter '取消筛选
End Sub

需要注意的是，上述代码中使用了一个字典对象来记录每个不同的值对应的颜色编号，因此需要在代码开始处加入以下语句以引用Microsoft Scripting Runtime库：

Option Explicit
'需要引用Microsoft Scripting Runtime库
Sub ColorDuplicates()
    Dim ws1 As Worksheet, ws2 As Worksheet, wsNew As Worksheet
    Dim lastRow As Long, i As Long
    Dim dict As Scripting.Dictionary, key As Variant
    Dim colorIndex As Integer
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1") '修改为实际的工作表名称
    Set ws2 = ThisWorkbook.Worksheets("Sheet2") '修改为实际的工作表名称
    Set dict = New Scripting.Dictionary
    
    '...
End Sub