Add Slicer Items to Naming Tab Results?

[drmingle]

I am using .::Excel 2010::.

How can I use the below information (specifically where "True" exists) to rename my worksheet within my workbook?:

    With ActiveWorkbook.SlicerCaches("Slicer_COID_NAME")
        .SlicerItems("Thompson").Selected = True
        .SlicerItems("Leonard").Selected = False
        .SlicerItems("Ronald").Selected = False
        .SlicerItems("Ralph").Selected = False
    End With

The code below works well - but produces the output "Pricing 05-21-2013" - I would prefer "Thomps Pricing 05-21-2013":

Sub CopyPricing()
'
' Objective:To keep pricing in a new iteration
'
Application.ScreenUpdating = False
    Cells.Select
    Selection.Copy
    Range("D3").Select
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Range("P2").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Select
    ActiveSheet.Name = ActiveSheet.Range("P2")
    Range("C1").Select
    ActiveWindow.DisplayGridlines = False
    
    Range("P2").Select
    Selection.Copy
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.Font
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = -0.499984740745262
    End With
    Selection.Font.Size = 12
    Selection.Font.Bold = True
    
Application.ScreenUpdating = True
End Sub

Any help would be appreciated...