XL 2010 RESOLU par jecherche : macro supprime les espaces quand il ne faut pas

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("E9:E16")) Is Nothing Then
   On Error Resume Next

   With Target
      ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
   End With
      If IsNumeric(Target) Then
            Call SupprimeEspaces
            If Len(Target) = 9 Then Target = Range("G7") & Target
            Application.ScreenUpdating = True
            Application.EnableEvents = True
      End If
End If
ActiveCell.Offset(0, 1).Select
End Sub

 Selection.Copy
ActiveCell.Offset(0, -4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=Fals