Faire fusionner deux codes

Bonjour

apres avoir essayé quelques manipulations pour joindre deux code ,(avoir un deux code en un ) je n'aboutis pas

voici le premier :

Option Explicit

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
Dim xcell As Range

If Not Intersect(Range("A2:A500"), Target) Is Nothing And Target.Count = 1 Then
'j'ajoute ca :
For Each xcell In Intersect(Range("A2:A500"), Target)
         Sheets("Feuil2").Range("K2") = xcell
        Next xcell

    For i = 21 To 100 'B1 à B21  remplies
        If Sheets("Feuil1").Cells(i, 2) = "" Then
            Sheets("Feuil1").Cells(i, 2) = Target.Value
            Sheets("Feuil1").Select
            Exit Sub
        End If
    Next
    MsgBox ("Aucune cellule libre, sur la feuille 1, de la cellule B1 à la cellule B21")
  End If

        End Sub

et

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Target, Range("B21:B100" & Range("A65536").End(xlUp).Row)) Is Nothing And Target.Count = 1 Then
    If Target = "" Then
        Exit Sub
    Else
            If Cells(Target.Row, Target.Column + 1) = "" Then
                If WorksheetFunction.Max(Range("C21:C100" & Range("A65536").End(xlUp).Row)) = 0 Then
                    Cells(Target.Row, Target.Column + 1) = 111000

                Else
                    Cells(Target.Row, Target.Column + 1) = WorksheetFunction.Max(Range("C21:C100" & Range("A65536").End(xlUp).Row)) + 1

                End If

            End If
        End If
    End If

Vous remerciant pour vos lumières

Bonjour

Pour comprendre ce serait bien de voir le fichier en question.

Il ya aussi des erreurs dans le code qui tu as posté ou plutôt des instruction qui ne servent pas.

If Not Intersect(Target, Range("B21:B100" & Range("A65536").End(xlUp).Row)) Is Nothing And Target.Count = 1 Then

à remplacer par

If Not Intersect(Target, Range("B21:B" & Range("A65536").End(xlUp).Row)) Is Nothing And Target.Count = 1 Then

ou

If Not Intersect(Target, Range("B21:B100")) Is Nothing And Target.Count = 1 Then

Dans le même esprit, la ligne worksheetfunction est aussi à corriger

Amicalement

merci !

...bon je vais faire plus simple pour ma question

le code suivant :

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        If Not Intersect(Target, Range("B21:B100" & Range("A65536").End(xlUp).Row)) Is Nothing And Target.Count = 1 Then
        If Target = "" Then
            Exit Sub
        Else
                If Cells(Target.Row, Target.Column + 1) = "" Then
                    If WorksheetFunction.Max(Range("C21:C100" & Range("A65536").End(xlUp).Row)) = 0 Then
                        Cells(Target.Row, Target.Column + 1) = 111000

                    Else
                        Cells(Target.Row, Target.Column + 1) = WorksheetFunction.Max(Range("C21:C100" & Range("A65536").End(xlUp).Row)) + 1

                    End If

                End If
            End If
        End If

me permet de generer des numeros d'ordre en colonne C en cliquant sur une cellule remplie de la colonne B de la meme feuille ,

je voudrai juste eviter le "clique" et poser comme condition que si ma cellule est remplie que le code precedent puisse s'executer

en vous remerciant pour toute idée

merci

re

comme condition que si ma cellule est remplie que le code precedent puisse s'executer

Quel code, le premier ou le deuxième de ton premier post ?

pardon !....

celui ci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        If Not Intersect(Target, Range("B21:B100" & Range("A65536").End(xlUp).Row)) Is Nothing And Target.Count = 1 Then
        If Target = "" Then
            Exit Sub
        Else
                If Cells(Target.Row, Target.Column + 1) = "" Then
                    If WorksheetFunction.Max(Range("C21:C100" & Range("A65536").End(xlUp).Row)) = 0 Then
                        Cells(Target.Row, Target.Column + 1) = 111000

                    Else
                        Cells(Target.Row, Target.Column + 1) = WorksheetFunction.Max(Range("C21:C100" & Range("A65536").End(xlUp).Row)) + 1

                    End If

                End If
            End If
        End If
end sub

j'ai trouvé en me documentant un peu !!!!!

j'ai uniquement changé

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

en

Private Sub Worksheet_Change(ByVal Target As Range)

et ca marche

Merci à vous

re,

Ok mais corrige ton code comme ceci :

Private Sub Worksheet_change(ByVal Target As Range)
If Not Intersect(Target, Range("B21:B100")) Is Nothing And Target.Count = 1 Then
    If Target = "" Then Exit Sub
        If Cells(Target.Row, Target.Column + 1) = "" Then
            If WorksheetFunction.Max(Range("C21:C100")) = 0 Then
                Cells(Target.Row, Target.Column + 1) = 111000
            Else
                Cells(Target.Row, Target.Column + 1) = WorksheetFunction.Max(Range("C21:C100")) + 1
            End If
        End If
    End If
End If
End Sub

Amicalement

merci pour ce plus , je vais l'adapter

cordialement , Rocket