XL 2010 Déplacement de plusieurs zones de texte dans excel vba

Private Sub CommandButton1_Click()
    Dim i&
    For i = 1 To 29
        With Feuil2
            .Shapes("ZoneTexte " & i).Left = .Shapes("ZoneTexte " & i * 100).Left
            .Shapes("ZoneTexte " & i).Top = .Shapes("ZoneTexte " & i * 100).Top
        End With
    Next
End Sub

Sub déplace()
Dim i&
    For i = 1 To 29
        With Feuil2
            .Shapes("ZoneTexte " & i).Left = .Shapes("ZoneTexte " & i).Left + .Range("M1").Left
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Sub GaucheDroite()
    Range("B5:J24").Cut Destination:=Range("O5:W24")
    Range("A1").Select
End Sub
Sub DroiteGauche()
    Range("O5:W24").Cut Destination:=Range("B5:J24")
    Range("A1").Select
End Sub

Sub SensAB()
   ShapePlageSourceVersCelluleCible Range("b5:j23"), Range("o5")
End Sub

Sub SensBA()
   ShapePlageSourceVersCelluleCible Range("o5:w24"), Range("b5")
End Sub

Sub ShapePlageSourceVersCelluleCible(PlageSource As Range, CelluleCible As Range)
Dim PlageCible As Range, xrgHaut As Range, xrgBas As Range, x As Shape, dx#, dy#, repSuppr
   ' plage cible (débute en CelluleCible et de mêmes dimensions que PlageSource
   Set PlageCible = CelluleCible.Resize(PlageSource.Rows.Count, PlageSource.Columns.Count)
   ' suppression des formes de la plage cible (à confirmer)
   ' si pas de suppression alors on ajoute les formes de la plage A vers la Plage B, c'est une
   ' espèce de superposition
   repSuppr = MsgBox("Voulez-vous supprimer toutes les formes ""ENTIèREMENT"" incluses" & _
      " dans la zone cible ? (pas de retour possible !)", vbYesNo + vbQuestion + vbDefaultButton2)
   If repSuppr = vbYes Then
      repSuppr = MsgBox("CONFIRMEZ-VOUS la suppression de toutes les formes ""ENTIèREMENT"" incluses" & _
      " dans la zone cible ? (pas de retour possible !)", vbYesNo + vbQuestion + vbDefaultButton2)
      If repSuppr = vbYes Then
         For Each x In Me.Shapes ' on supprime les formes "ENTIéREMENT" incluses dans la plage cible
            If Not Intersect(x.TopLeftCell, PlageCible) Is Nothing Then
               If Not Intersect(x.BottomRightCell, PlageCible) Is Nothing Then x.Delete
            End If
         Next x
      End If
   End If
   ' Translation à faire : dx déplacement horizontal - dy déplacement vertical
   dx = PlageCible.Left - PlageSource.Left: dy = PlageCible.Top - PlageSource.Top
   ' déplacement des formes "ENTIéREMENT" incluses dans la plage source vers la plage cible
   For Each x In Me.Shapes ' pour chaque forme x de la feuille
      ' si x est "ENTIéREMENT" incluse dans la plage source alors on la déplace vers la cible
      If Not Intersect(x.TopLeftCell, PlageSource) Is Nothing Then
      If Not Intersect(x.BottomRightCell, PlageSource) Is Nothing Then
         x.Top = x.Top + dy: x.Left = x.Left + dx  ' déplacement par translation (dy,dx)
         x.ZOrder msoBringToFront   ' la forme qu'on vient de déplacer est mise à l'avant-plan
      End If: End If
   Next x
End Sub

Sub déplace()
Dim i&
    With Feuil2
        Set Source = Application.InputBox("cliquez dans la cellule de gauche de la zone source", Type:=8)
        Set cible = Application.InputBox("cliquez dans la cellule de gauche de la zone destination", Type:=8)
        
        If Source.Left < cible.Left Then
            DéplHori = cible.Left
        Else
            DéplHori = cible.Left - Source.Left
        End If
        If Source.Top < cible.Top Then
            DéplVert = cible.Top
        Else
            DéplVert = cible.Top - Source.Top
        End If
        For i = 1 To 29
            .Shapes("ZoneTexte " & i).IncrementLeft DéplHori
            .Shapes("ZoneTexte " & i).IncrementTop DéplVert
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub