DEPLACEMENT AVEC TABULATION

bennisay

XLDnaute Occasionnel
bonjour LE FORUM

j ai une question . comment combiner deux codes VBA pour faire ca

Si Je suis sur la cellule "b1" je veux me deplacer sur la cellule "a3" avec tabulation


Et si je suis sur la cellule "b5" je veux me deplacer sur la cellule "a6" avec tabulation
Et si je suis sur la cellule "b6" je veux me deplacer sur la cellule "a7" avec tabulation

ma feuille est nomé " MOUVEMENT"
Merci pour votre aide
 

pierrejean

XLDnaute Barbatruc
Bonjour bennisay

A tester dans le module de la feuille

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$1" Then Range("A3").Select
If Target.Address = "$C$5" Then Range("A6").Select
If Target.Address = "$C$6" Then Range("A7").Select
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Bennisay, bonjour le forum,

Tu peux essayer comme ça :

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$1" Then Range("A3").Select
If Target.Address = "$C$5" Then Range("A6").Select
If Target.Address = "$C$6" Then Range("A7").Select
End Sub
À placer dans l'onglet concerné... Mais attention ! Pour pouvoir désormais sélectionner les cellules C1, C5 ou C6 de cet onglet, il te faudra désactiver les macros événementielles.
Je te recommande de copier aussi, dans un module standard les deux macros si-dessous pour désactiver et réactiver :

VB:
Sub Desactiv()
Application.EnableEvents = False
End Sub

Sub Activ()
Application.EnableEvents = True
End Sub

[Edition]
Bonjour PierreJean nos posts se sont croisés...
 

pierrejean

XLDnaute Barbatruc
Re
Salut Robert
Alors tester:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then Range("A3").Select
If Target.Address = "$B$5" Then Range("A6").Select
If Target.Address = "$B$6" Then Range("A7").Select
End Sub

Toujours a mettre dans le module de la feuille
 

bennisay

XLDnaute Occasionnel
REB
Desole mais quand j ai mis le code fournis dans tt ces codes j ai eu un message d erreur
pourriez vous m indiquer ou je dois mettre le code et quesque je dois changer et merci

quand j ai dis que ca fonctionne c etait sur un dossier vide mais sur mon propre dossier avec les codes j ai ps resussis





Code:
Dim a()
Private Sub ComboBox2_Change()
If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, a, 0)) Then
   Me.ComboBox2.List = Filter(a, Me.ComboBox2.Text, True, vbTextCompare)
   Me.ComboBox2.DropDown
End If
   ActiveCell.Value = Me.ComboBox2
End Sub
Private Sub ComboBox3_Change()
   ActiveCell.Value = Me.ComboBox3
End Sub
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox2.List = a
  Me.ComboBox2.Activate
  Me.ComboBox2.DropDown
End Sub
Private Sub CommandButton1_Click()
Dim msg, style, title

    Dim Retour As Integer

    With Sheets("LIVRAISON")
  
       
    '---------------- Impression noir et blanc ou couleur ------------------------
    Retour = MsgBox("Voulez-vous une copie couleur : N/O ", vbNoYes + vbCritical)
    If Retour = vbNo Then
        With ActiveSheet.PageSetup
            .BlackAndWhite = True
        End With
    End If
    ActiveSheet.PageSetup.PrintArea = "B2:I55"
    'ActiveSheet.PrintPreview
    ActiveWindow.SelectedSheets.PrintPreview 'PrintOut copies:=1
End With
End Sub

Private Sub CommandButton2_Click()
UserForm3.Show
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect([H7:H35], Target) Is Nothing Then
Application.OnKey Key:="~", procedure:="retour_colonneC"

End If


  If Not Intersect([C7:C35], Target) Is Nothing And Target.Count = 1 Then
    a = Application.Transpose(Sheets("bdd").Range("liste"))
    Me.ComboBox2.List = a
    Me.ComboBox2.Height = Target.Height + 3
    Me.ComboBox2.Width = Target.Width
    Me.ComboBox2.Top = Target.Top
    Me.ComboBox2.Left = Target.Left
    Me.ComboBox2 = Target
    Me.ComboBox2.Visible = True
    Me.ComboBox2.Activate
    'Me.ComboBox1.DropDown    ' ouverture automatique au clic dans la cellule (optionel)
  Else
     Me.ComboBox2.Visible = False
  End If
  If Not Intersect([d7:d35], Target) Is Nothing And Target.Count = 1 Then
    b = Range("liste_depots_bon_livraison")
    Me.ComboBox3.List = b
    Me.ComboBox3.Height = Target.Height + 3
    Me.ComboBox3.Width = Target.Width
    Me.ComboBox3.Top = Target.Top
    Me.ComboBox3.Left = Target.Left
    Me.ComboBox3 = Target
    Me.ComboBox3.Visible = True
    Me.ComboBox3.Activate
    'Me.ComboBox1.DropDown    ' ouverture automatique au clic dans la cellule (optionel)
  Else
    Me.ComboBox3.Visible = False
  End If

If Not Intersect(Target, Worksheets("LIVRAISON").Range("C59:D64")) Is Nothing Then
    Worksheets("LIVRAISON").Range("R12").Select
End If
   
    If Not Intersect(Target, Worksheets("LIVRAISON").Range("J1:P6")) Is Nothing Then
        Worksheets("LIVRAISON").Range("R12").Select
    End If
       
        If Not Intersect(Target, Worksheets("LIVRAISON").Range("A1:B6")) Is Nothing Then
            Worksheets("LIVRAISON").Range("R12").Select
        End If

            If Not Intersect(Target, Worksheets("LIVRAISON").Range("E2:E4")) Is Nothing Then
                Worksheets("LIVRAISON").Range("R12").Select
            End If

                If Not Intersect(Target, Worksheets("LIVRAISON").Range("C2:H2")) Is Nothing Then
                    Worksheets("LIVRAISON").Range("R12").Select
                End If

                    If Not Intersect(Target, Worksheets("LIVRAISON").Range("B6:I6")) Is Nothing Then
                        Worksheets("LIVRAISON").Range("R12").Select
                    End If

                        If Not Intersect(Target, Worksheets("LIVRAISON").Range("D1:I1")) Is Nothing Then
                            Worksheets("LIVRAISON").Range("R12").Select
                        End If

                            If Not Intersect(Target, Worksheets("LIVRAISON").Range("R1:R2")) Is Nothing Then
                                Worksheets("LIVRAISON").Range("R12").Select
                            End If
                               
                                If Not Intersect(Target, Worksheets("LIVRAISON").Range("F37:I37")) Is Nothing Then
                                    Worksheets("LIVRAISON").Range("R12").Select
                                End If
                               
                                    If Not Intersect(Target, Worksheets("LIVRAISON").Range("I46")) Is Nothing Then
                                        Worksheets("LIVRAISON").Range("R12").Select
                                    End If
                                   
                                        If Not Intersect(Target, Worksheets("LIVRAISON").Range("J7:J35")) Is Nothing Then
                                            Worksheets("LIVRAISON").Range("R12").Select
                                        End If
                                            If Not Intersect(Target, Worksheets("LIVRAISON").Range("N1:N1")) Is Nothing Then
                                                Worksheets("LIVRAISON").Range("R12").Select
                                            End If
                                              If Not Intersect(Target, Worksheets("LIVRAISON").Range("T7:AN35")) Is Nothing Then
                                                  Worksheets("LIVRAISON").Range("R12").Select
                                               End If
                                                If Not Intersect(Target, Worksheets("LIVRAISON").Range("E5")) Is Nothing Then
                                                    Worksheets("LIVRAISON").Range("R12").Select
                                                 End If
                                                    If Not Intersect(Target, Worksheets("LIVRAISON").Range("I6:I35")) Is Nothing Then
                                                        Worksheets("LIVRAISON").Range("R12").Select
                                                     End If
                                                
End Sub

' code pour avertirtissement de doublon dans la colonne "C"

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Colonne As Integer
    Dim Adresse As String
   
    'On sort si plus d'une cellule a été modifiée
    If Target.Count > 1 Then Exit Sub
    'On sort si la cellule modifiée est vide
    If Target.Value = "" Then Exit Sub
   
    'Définit la colonne à vérifier (1=Colonne A, 2=colonne B ...etc...)
    Colonne = 3
         
    'Vérifie si c'est la colonne cible a été modifiée
    If Target.Column = Colonne Then
   
        'Recherche si la nouvelle donnée existe déjà dans la colonne.
        Adresse = Columns(Colonne).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _
            SearchDirection:=xlNext).Address
           
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la colonne.
        If Adresse <> Target.Address Then
       
            MsgBox "La Réference '" & Target & "' Déjà saisie ", vbExclamation
           
        End If
    End If
   
End Sub




Sub masquer_barre()
ActiveWindow.DisplayWorkbookTabs = False
End Sub
 

pierrejean

XLDnaute Barbatruc
RE
a tester :

mettre ces 3 lignes
If Target.Address = "$B$1" Then Range("A3").Select
If Target.Address = "$B$5" Then Range("A6").Select
If Target.Address = "$B$6" Then Range("A7").Select

tout de suite apres le
Private Sub Worksheet_Change(ByVal Target As Excel.Range) existant
 

bennisay

XLDnaute Occasionnel
BONJOUR LE FORUM pierrejean Robert
Je suis ps un expert dans les VBA donc j ai ps reussis a faire fonctionner le code . le probleme c est que le fichier est plein de codes donc et de fonctions du meme les cellules que je voulu mettre la celections contiennent des listes deroulantes donc le code ne fonctionne ps comme prevus sur mon fichier d exemple pour cela je vous fait part de mon fichier d origine comme ca vous allez savoir comment ce se passe
et merci infiniment
 

Pièces jointes

  • GOOD BUSINESS 2016 Edition N° 4 TESTE.xlsm
    196.6 KB · Affichages: 46

Discussions similaires

Réponses
10
Affichages
302

Statistiques des forums

Discussions
312 875
Messages
2 093 147
Membres
105 639
dernier inscrit
crobyx