La méthode 'Range' de l'objet '_Worksheet' a échoué

Bonjour,
Je cherche à colorer x cellules consécutives en ligne selon la valeur d'une cellule, continuer la coloration en suivant selon la valeur d'une autre cellule et ainsi de suite.

Pour cela, j'ai le code suivant:
Dans feuil1 (Feuil1):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Application.Intersect(Target, Range("TPS")) Is Nothing Then
        Rows("6:6").Interior.Pattern = xlNone
        If Range("B1") <> "" And Range("B1") <> 0 Then
            CBr = Range("B1")
            Cells(6, 2).Resize(, CBr).Interior.Color = vbRed
        End If
        If Range("B2") <> "" And Range("B2") <> 0 Then
            CBl = Range("B2")
            Cells(6, 2 + CBr).Resize(, CBl).Interior.Color = vbBlue
        End If
        If Range("B3") <> "" And Range("B3") <> 0 Then
            CBv = Range("B3")
            Cells(6, 2 + CBr + CBl).Resize(, CBv).Interior.Color = vbGreen
        End If
        If Range("B4") <> "" And Range("B4") <> 0 Then
            CBc = Range("B4")
            Cells(6, 2 + CBr + CBl + CBv).Resize(, CBc).Interior.Color = vbMagenta
        End If
            
    End If
End Sub

Et dans Module 1:

Sub Macro1()
'
' Macro1 Macro
'

'
    Rows("13:13").Interior.Pattern = xlNone
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Cependant, j'ai un message d'erreur qui s'affiche lors de l'exécution de la macro1: "Erreur d'exécution '1004':La méthode 'Range' de l'objet '_Worksheet' a échoué". Et lors du débogage, la ligne "If Not Application.Intersect(Target, Range("TPS")) Is Nothing Then" se surligne. Cependant je ne sais pas quoi modifier pour que ça marche...

Merci de m'apporter un peu d'aide... =)

EDIT: Ajout de la coloration syntaxique.