Problème avec selection

Bonjour,

Je coince sur les instruction suivantes :

je sélectionne avec la souris. je récupère bien ma sélection dans n1689, mais quand je je descend sur la ligne vide.

Il bloque sur ma dernière ligne d'instruction. Je pense que cela vient de sélection qui doit changer d'état.

Mais comment faire. merci de me donner une piste ci possible.

Selection.Copy
Application.CutCopyMode = False
Selection.Select
Range("n1689") = Selection
Selection.End(xlDown).Offset(1, 0).Select

Bonjour,

Serait-il possible de nous dire ce que tu veux faire exactement ? Il y a de grosses incohérences dans ce script, et plus généralement les sélections sont parfaitement inutiles en VBA. Le mieux serait donc de partir sur des bonnes bases : décrit ton besoin et on te proposera quelque chose.

bonjour,

Je voudrais sélectionner avec la souris deux cellules de la même colonne et les copiés sur la première cellule vide de le même colonne.

Merci de ton aide.

Bonjour,

A placer dans le module de votre onglet :

Option Explicit

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

Dim I As Integer, Colonne As Long, DerniereLigne As Long
Dim TabCellules As Variant

    If Selection.Count = 2 Then
       TabCellules = Split(Selection.Address, ",")
       If Range(TabCellules(0)).Column = Range(TabCellules(1)).Column Then
          Colonne = Range(TabCellules(0)).Column
          DerniereLigne = Cells(Rows.Count, Colonne).End(xlUp).Row + 1
          Cells(DerniereLigne, Colonne) = Range(TabCellules(0)) & " " & Range(TabCellules(1))
       End If
    End If

    Cancel = True

End Sub

Bonjour,

Ton fichier ne fonctionne pas chez moi.

If Range(TabCellules(0)).Column = Range(TabCellules(1)).Column Then

l'indice n'appartient pas a la sélection erreur 9

Merci pour ton aide.

OK,

Dans l'éditeur VBA, que donne le débogage ?

Il est possible que la fonction Split n'existe pas dans votre version 2007.

Dans l'explorateur d'objets, qu'avez-vous pour Split ? L'explorateur d'objet est le premier icône à gauche du point d'interrogation.

Nb : Pour fermer la fenêtre, cliquer sur la petite croix à droite.

Les références présentes chez moi, ne tenez pas compte du 16.0.

bonjour,

split existe office, vba, excel.

Microsoft office 12.0 objet library existe mais 16.

j'espère que cela peut aider.

Bizarre, bizarre...

Remplacez le code par celui-ci :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

Dim I As Integer, Colonne As Long, DerniereLigne As Long, PositionVirgule As Integer
Dim TabCellules As Variant
Dim Coordonnee1 As String, Coordonnee2 As String

    Coordonnee1 = "": Coordonnee2 = ""
    If Selection.Count = 2 Then
       TabCellules = Selection.Address
       For I = 1 To Len(TabCellules)
           If Mid(TabCellules, I, 1) <> "," Then
              Coordonnee1 = Coordonnee1 & Mid(TabCellules, I, 1)
           Else
              PositionVirgule = I
              Exit For
           End If
       Next I

       For I = PositionVirgule + 1 To Len(TabCellules)
           Coordonnee2 = Coordonnee2 & Mid(TabCellules, I, 1)
       Next I

       If Range(Coordonnee1).Column = Range(Coordonnee2).Column Then
          Colonne = Range(Coordonnee1).Column
          DerniereLigne = Cells(Rows.Count, Colonne).End(xlUp).Row + 1
          Cells(DerniereLigne, Colonne) = Range(Coordonnee1) & " " & Range(Coordonnee2)
       End If
    End If

    Cancel = True

End Sub

bonjour,

Ça ne fonctionne pas.

incompatibilité de type erreur 13

Cells(DerniereLigne, Colonne) = Range(Coordonnee1) & " " & Range(Coordonnee2)

Désolé

bonjour le fil,

une possibilité

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     Dim c As Range
     With Selection
          If .Cells.Count = 2 And .Columns.Count = 1 And .Areas.Count = 1 Then     '2 cellules dans une colonne et contigious
               Set c = Cells(Rows.Count, .Column).End(xlUp).Offset(1)
               c.Resize(2).Value2 = .Value2
               Cancel = True
               Application.CutCopyMode = False
               Application.Goto c
          End If
     End With
End Sub

Bonjour,

Merci de votre aide ça fonctionne.

cordialement

Bonjour à tous,

€hemau, j'ai compris le problème avec le code de Bart qui considère deux cellules contigües.

Dans votre message :

Je voudrais sélectionner avec la souris deux cellules de la même colonne et les copiés sur la première cellule vide de le même colonne.

• Implicitement, j'ai considéré que les cellules ne se suivaient pas obligatoirement et que pour sélectionner les cellules à copier on passait par :

Sélection cellule 1 + la touche Alt gr + Sélection cellule 2

• Implicitement également, j'ai considéré que les contenus étaient concaténés parce que la demande était libellée dans ce sens.

Si vous essayez avec cette méthode, vous pourrez vérifier le résultat. Je vous conseille d'utiliser ma première version.

oubienµ

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     Dim c As Range, c1 As Range, cnt As Integer, bDrapeau, Arr(1, 1)
     With Selection
          If .Cells.Count = 2 Then           '2 cellules
               For Each c1 In .Cells
                    Arr(cnt, 0) = c1.Column  'Numéro de la colonne
                    bDrapeau = (VarType(c1.Value) = vbError)     'contenu n'est pas erroné
                    If bDrapeau Then Exit For
                    Arr(cnt, 1) = c1.Value2  'contenu de la cellule
                    cnt = cnt + 1
               Next

               If bDrapeau Then
                    MsgBox "erreur contenu cellule"
               ElseIf Arr(0, 0) = Arr(1, 0) Then     'même colonne
                    Set c1 = Cells(Rows.Count, Arr(0, 0)).End(xlUp).Offset(1)     'destination
                    c1.Resize(2).Value = Application.Transpose(Array(Arr(0, 1), Arr(1, 1)))     'coller les 2 valeurs
                    Cancel = True
                    Application.CutCopyMode = False
                    Application.Goto c1
               End If
          End If
     End With
End Sub

Merci a tous pour votre aide.