Réunir deux codes VBA Private sub Worksheets_Change

Bonjour à tous,
J'espère que vous allez bien !

Comme il n'est pas possible d'avoir deux code VBA Private sub Worksheets_Change sur la même feuille, j'ai donc essayé de les réunir.
Mais étant mauvais en VBA, je n'ai pas réussi ...
J'ai tenté pas mal de chose, changement des variables, combinaison des "If" etc... Mais en vain.

Merci par avance pour votre aide :)

Voici les deux codes (ils sont pratiquement identiques) :

Bonjour

Lorsque vous mettez un code, utilisez les balises de code disponibles en cliquant sur l'icone </> ou alors mettez votre fichier en ligne

Là on est obligé de tout réécrire....

Cordialement

Bonjour Neqoh, Dan,

Plutôt que de quitter la sub si l'adresse n'est pas bonne, indiquer les instructions à exécuter si l'adresse est la bonne. Par exemple :

If Target.Address ........="D4" Then
    ...
    instruction 
    instruction
    ...
End If    
If Target.Address ........="C4" Then
    ...
    instruction
    instruction
    ...
End If    

A+

Bonjour,

A adapter.

Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet, Cell As Range
    If Not Intersect(Target, Range("C4:D4")) Is Nothing And Target.Count = 1 Then
        If Not IsEmpty(Target) Then
            Set ws = Worksheets("Rapport 1")
            Select Case Target.Address(0, 0)
                Case "C4":
                    Set Cell = ws.Range("A2:A38949").Find(VBA.UCase(Target.Value), , xlValues, xlWhole)
                    If Not Cell Is Nothing Then
                        '---
                        '---
                    End If
                Case "D4":
                    Set Cell = ws.Range("B2:B38949").Find(VBA.UCase(Target.Value), , xlValues, xlWhole)
                    If Not Cell Is Nothing Then
                        '---
                        '---
                    End If
            End Select
            If Cell Is Nothing Then MsgBox "Vérifier l'orthographe !", 64, "Information"
        End If
    End If
End Sub

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("C4:D4")) Is Nothing And Target.Count = 1 Then
    With Worksheets("Rapport 1")
        Set Cell = .Range(.Cells(2, Target.Column - 2), .Cells(38949, Target.Column - 2)).Find(VBA.UCase(Target.Value), , xlValues, xlWhole)
        If Not Cell Is Nothing Then
        End If
    End With
 End If

End Sub

Merci beaucoup pour toutes vos réponses ! C'est super gentil !
Jean-Eric, merci votre code marche ! J'ai juste un petit soucis. Dans l'ancien code je venais incrémenter une case sur la gauche de la case cible. Exemple : La case cible était D4, et je lui demandais d'incrémenter E4,F4,G4 mais aussi C4. Pour cela je mettais simplement cette ligne de code " Target.Offset(, -1).Value = Cell.Offset(, -1).Value". Et cela marchait bien.
Mais maintenant lorsque je l'ajoute à mon code, il me renvoi un message d'erreur :/

Merci encore pour toutes vos aide !