Insertion carte de France + coloration selon données.

Sub ColorMap()
    Dim oSheet As Excel.Worksheet    ' Feuille
    Dim lLine As Long    ' Numéro de ligne
    Dim loShape As Shape    ' Forme
    Dim lColor As Long    ' Couleur
    Dim Gap As Long     ' Echelle
    Gap = Int(Application.Max(Range("B:B")) / 8)
    If Gap = 0 Then Gap = 1
' Feuille contenant la carte
    Set oSheet = ThisWorkbook.Sheets("Répartition")
    ' Désactive le remplissage de la carte
    oSheet.Shapes("CarteFrance").Fill.Visible = msoFalse
    ' Pour chaque ligne de Visites
    For lLine = oSheet.UsedRange.Row + 1 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
        If oSheet.Cells(lLine, 2) >= "" Then lColor = vbWhite
        If oSheet.Cells(lLine, 2) >= 1 And oSheet.Cells(lLine, 3) <= Gap Then lColor = vbWhite
        If oSheet.Cells(lLine, 2) >= Gap + 1 And oSheet.Cells(lLine, 3) <= 2 * Gap Then lColor = 13209
        If oSheet.Cells(lLine, 2) >= 2 * Gap + 1 And oSheet.Cells(lLine, 3) <= 3 * Gap Then lColor = 255
        If oSheet.Cells(lLine, 2) >= 3 * Gap + 1 And oSheet.Cells(lLine, 3) <= 4 * Gap Then lColor = 39423
        If oSheet.Cells(lLine, 2) >= 4 * Gap + 1 And oSheet.Cells(lLine, 3) <= 5 * Gap Then lColor = 65535
        If oSheet.Cells(lLine, 2) >= 5 * Gap + 1 And oSheet.Cells(lLine, 3) <= 6 * Gap Then lColor = 52749
        If oSheet.Cells(lLine, 2) >= 6 * Gap + 1 And oSheet.Cells(lLine, 3) <= 7 * Gap Then lColor = 52377
        If oSheet.Cells(lLine, 2) >= 7 * Gap + 1 And oSheet.Cells(lLine, 3) <= 8 * Gap Then lColor = 26637
        If oSheet.Cells(lLine, 2) >= 8 * Gap + 1 Then lColor = 16763904

        ' Parcours les départements de la carte
        For Each loShape In oSheet.Shapes("CarteFrance").GroupItems
            ' Si la forme loShape a pour nom la valeur de la première colonne (l'identifiant FR-XX)
            If loShape.Name = oSheet.Cells(lLine, 1) Then
                ' Réactive le remplissage de la forme
                loShape.Fill.Visible = True
                ' Type de remplissage = couleur unie
                loShape.Fill.Solid
                ' Pas de transparence
                loShape.Fill.Transparency = 0#
                ' Couleur de remplissage
                loShape.Fill.ForeColor.RGB = lColor
                ' La forme a été trouvée => on sort de la boucle
                Exit For
            End If
        Next
    Next
    For t = 1 To 9
      Cells(35 + t, 3) = "'" & Gap * (t - 1) & "-" & Gap * t
    Next t
End Sub