Liste colonne A et B en couleur

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim derlig1, derlig2, x, Color(1), MemColor1, MemColor2, MemPCG
    
    'couleurs a adapter
    Color(0) = vbCyan
    Color(1) = vbGreen
    
    derlig1 = Range("A" & Rows.Count).End(xlUp).Row
    derlig2 = Range("B" & Rows.Count).End(xlUp).Row
    For x = 1 To derlig1
        'couleurs liste colonne A
        'Premier Caractere a Gauche
        PCG = Left(Range("A" & x), 1)
        'teste chiffre
        If PCG >= "0" And PCG <= 9 Then
            Range("A" & x).Interior.Color = Color(0)
            MemColor1 = 0
        Else
            'test memoire PCG = PCG et ensuite test memoire couleur
            'pour changement couleur
            If PCG <> MemPCG Then
                MemPCG = PCG
                If MemColor1 = 0 Then
                    MemColor1 = 1
                Else
                    MemColor1 = 0
                End If
                Range("A" & x).Interior.Color = Color(MemColor1)
            Else
                Range("A" & x).Interior.Color = Color(MemColor1)
            End If
        End If
        
        'Couleur liste colonne B
        If x <= derlig2 Then
            Range("B" & x).Interior.Color = Color(x Mod 2)
        End If
        
    Next x
End Sub

Function ChoisirDossier()
  Dim objShell, objFolder, SecuriteSlash As Byte
  
  With UserForm1
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisissez un répertoire", &H1&)
        Volume = Left(objFolder.ParentFolder, Len(objFolder.ParentFolder) - 4) & " "
    
    If objFolder Is Nothing Then GoTo EndProc
    If Left(objFolder.self.Path, 2) = ":" Then GoTo EndProc

    ChoisirDossier = objFolder.self.Path
    SecuriteSlash = InStr(objFolder.Title, ":")
    Chemin = objFolder.self.Path

    If SecuriteSlash > 0 Then ChoisirDossier = Left(ChoisirDossier, Len(ChoisirDossier) - 1)
EndProc:
    Set objFolder = Nothing
    Set objShell = Nothing
    .Label2.Caption = "Disque dur: " & Volume   'Disque dur
    .Label3.Caption = "Répertoire: " & Chemin   'Chemin répertoire
  End With
End Function

Function ChoisirDossier()
  Dim objShell, objFolder, SecuriteSlash As Byte
  
  With UserForm1
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisissez un répertoire", &H1&)
    
    If objFolder Is Nothing Then GoTo EndProc
    If Left(objFolder.self.Path, 2) = ":" Then GoTo EndProc
    
    Volume = Left(objFolder.ParentFolder, Len(objFolder.ParentFolder) - 4) & " "

    ChoisirDossier = objFolder.self.Path
    SecuriteSlash = InStr(objFolder.Title, ":")
    Chemin = objFolder.self.Path

    If SecuriteSlash > 0 Then ChoisirDossier = Left(ChoisirDossier, Len(ChoisirDossier) - 1)
    
    .Label2.Caption = "Disque dur: " & Volume   'Disque dur
    .Label3.Caption = "Répertoire: " & Chemin   'Chemin répertoire
    
EndProc:
    Set objFolder = Nothing
    Set objShell = Nothing
  End With
End Function

Sub UserForm_Click()
Dim Fso, F, Fc
    ListBox1.Clear
    Columns("A:A").ClearContents
    Set Fso = CreateObject("Scripting.FileSystemObject")

    Set F = Fso.Getfolder(Chemin)  '*** Erreur mets ligne se mets en jaune

For Each Fc In F.Files
    ListBox1.AddItem Fc.Name
Next
    Set Fso = Nothing
    
'*** Transfert automatiquement la liste vers la Feuil1
    With ListBox1
        Sheets("Feuil1").Range(Cells(1, 1), Cells(.ListCount, 1)) = .List
    End With
        Label1.Caption = ListBox1.ListCount & " Films"    'Nombres de films
End Sub

Private Sub ToggleButton7_Click()
   If ToggleButton7 = True Then
      ToggleButton7.BackColor = vbGreen

            Chemin = ChoisirDossier          'Appel de la fonction
      
      ToggleButton7 = False
      ToggleButton7.BackColor = vbGreen
  End If

End Sub