Déplacer une carte dynamique à la deuxième feuille

Bonjour,

J'ai beau essayer de déplacer la carte de France mise ci-joint à la deuxième feuille de mon fichier Excel, mes efforts n'ont pas porté leurs fruits...

Je découvre le b.a-ba de VBA, voilà la cause Lorsque je déplace la carte, la macro ne marche plus.. même avec modification du numéro de la worksheet sur le code VBA

Pourriez-vous m'aidez à chercher une solution ?

Moi ça fonctionne : il faut changer le numéro du sheets(1) pour mettre le numéro de ta feuille, et il faut aussi copier le code de la feuille d'origine dans le code de la nouvelle feuille.

Merci de votre réponse.

Vous voudriez bien me corriger, si je n'ai pas bien compris :

1- J'ajouterais une deuxième feuille.

2 - Dans la barre de menu de VBA, je clique sur Feuille 2 et je copie le code de le Feuille 1 dans la Feuille 2.

3- Dans le code, je cherche toute ligne dans les codes où il y'a worksheet(1) et je la remplace par worksheet (2) ?

Par avance, Merci

Je me permets de vous rappeler que je ne voudrais déplacer que la carte de France et laisser le tableau sur la feuille 1.

Autant pour moi, je n'avais pas bien saisi votre soucis :

Pour laisser le tableau en feuille 1 et la carte en feuille 2, pas besoin de recopier le code de la feuille, juste à modifier le code de la macro :

Sub ColorieDepartement(CelMod As Range)
    Dim Ligne As Long
    Dim Couleur As Long
    Dim Formes As Object

    Ligne = CelMod.Row
    With ThisWorkbook.Sheets(2)
            Set Formes = .Shapes(ThisWorkbook.Sheets(1).Cells(Ligne, 2))
            With Formes
                .Fill.Solid
                .Fill.Transparency = 0#
                .Fill.ForeColor.RGB = CouleurDep(ThisWorkbook.Sheets(1).Cells(Ligne, 3).Value)
                With .TextFrame2.TextRange
                    .Characters.Text = ThisWorkbook.Sheets(1).Cells(Ligne, 3).Value
                    .Characters().Font.Size = 8
                    .Parent.VerticalAnchor = msoAnchorMiddle
                    .Parent.HorizontalAnchor = msoAnchorNone
                End With
            End With
    End With
End Sub

Merci pour ce code.

Toutefois, la suppression de la liste bogue et l'application s'arrête

Ah mince j'ai pas du tout touché au code du bouton. Il est à modifier aussi :

Private Sub BoutonEffacer_Click()
Dim Reponse As Variant
Dim PosCel As Byte
Application.EnableEvents = False
Reponse = MsgBox("Voulez-vous vraiment tout effacer?", vbYesNo, "Effacement")
If Reponse = vbYes Then
    Application.ScreenUpdating = False
    For PosCel = 0 To Range(Range("B2"), Range("B2").End(xlDown)).Offset(0, 1).Cells.Count - 1
        Range("C2").Offset(PosCel, 0).ClearContents
    Next PosCel
    ThisWorkbook.Sheets(2).Shapes("CarteFrance").Fill.ForeColor.RGB = 16777215  ' Blanc
    For i = 2 To 97
        Sheets(2).Activate
      Sheets(2).Shapes.Range(Array(Sheets(1).Cells(i, 2))).Select
      Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ""
    Next
    Sheets(1).Activate
    Sheets(1).Cells(2, 3).Select
    Application.ScreenUpdating = True
End If
Application.EnableEvents = True
End Sub