Sub Worksheet_change(ByVal Target As Excel.Range)

Bonjour j'ai deux tableaux à remplir le premier comporte ce code :

Sub Worksheet_change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [H39]) Is Nothing Then Exit Sub

'La case H39 est une liste déroulante de choix de nom d'entreprise, et selon si on choisi entreprise 1, ou entreprise 2, ect... ca remplit automatiquement toutes les autres cases :

If Trim(Target) = "entreprise 1" Then Range("H40").Value = "Adresse entreprise 1"
If Trim(Target) = "entreprise 1" Then Range("M40").Value = "Code postal entreprise 1"
If Trim(Target) = "entreprise 1" Then Range("H41").Value = "Numéro entreprise 1"
If Trim(Target) = "entreprise 1" Then Range("B43").Value = "Prénom NOM correspondant PR entreprise 1"
If Trim(Target) = "entreprise 1" Then Range("H43").Value = "Contact correspondant entreprise 1"

If Trim(Target) = "entreprise 2" Then Range("H40").Value = "Adresse entreprise 2"
If Trim(Target) = "entreprise 2" Then Range("M40").Value = "Code postal entreprise 2"
If Trim(Target) = "entreprise 2" Then Range("H41").Value = "Numéro entreprise 2"
If Trim(Target) = "entreprise 2" Then Range("B43").Value = "Prénom NOM correspondant PR entreprise 2"
If Trim(Target) = "entreprise 2" Then Range("H43").Value = "Contact correspondant entreprise 2"

Mes questions sont les suivantes : comment faire pour réaliser la même chose pour une autre case (avec cependant je précise la même liste déroulante) : le tableau correspondant à la case H39 + un autre tableau correspondant à la case H58. Je précise que le code ci dessus est écrit dans la feuille et donc je ne peux pas simplement écrire 2 Sub Worksheet_change(ByVal Target As Excel.Range)

Est-il possible de rendre ce code plus compact et propre ?

PS : Je ne sais pas si cela peut faciliter le fait que j'ai un tableau qui référence ces infos :

A | B | C | D | E | F

Nom entreprise | Adresse | Code postal | Numéro entreprise | Correpondant PR | Contact correpondant

x | x | x | x | x | x

x | x | x | x | x | x

x | x | x | x | x | x

x | x | x | x | x | x

et donc que selon ce qui est écrit à la case H39 ca cherche la ligne correpondante dans le tableau et ca prend les valeurs de la ligne correpondante

du genre si H39 = A4 alors H40 = B4 ect...

Aucune idée si c'est possible ou non.

Je vous remercie

Bonsoir le fil, bonsoir le forum,

Pas sûr d'avoir bien compris mais si les deux tableau ont la même structure le code ci-dessous devrait convenir :

Sub Worksheet_change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("H39"), Range("H58")) Is Nothing Then Exit Sub
Select Case Trim(Target.Value)
    Case "Entreprise 1"
        Raj = " 1"
    Case "Entreprise 2"
        Raj = " 2"
End Select
Cells(Target.Row + 1, "H").Value = "Adresse entreprise" & Raj
Cells(Target.Row + 1, "M").Value = "Code Postal Entreprise" & Raj
Cells(Target.Row + 2, "H").Value = "Numéro Entreprise" & Raj
Cells(Target.Row + 4, "B").Value = "Prénom NOM correspondant PR Entreprise" & Raj
Cells(Target.Row + 4, "H").Value = "Contact correspondant Entreprise" & Raj
End Sub

Ooops doublon !...

Bonjour,

eric

Bonjour,

Une proposition.

Les données Entreprises sont sous forme de tableau structuré dans une feuille distinctes (!?).

Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TD As Range, vCol
    If Target.Address = "$H$39" Then
        Me.Range("H40,M40,H41,B43,H43").ClearContents
        If Not IsEmpty(Target) Then
            Set TD = Worksheets("Entreprises").Range("T_Entreprises")
            vCol = Application.Match(Target.Value, TD.Columns(1), 0)
            'If Not IsError(vCol) Then
                With Me
                    .Range("H40").Value = TD(vCol, 2).Value
                    .Range("M40").Value = TD(vCol, 3).Value
                    .Range("H41").Value = TD(vCol, 4).Value
                    .Range("B43").Value = TD(vCol, 5).Value
                    .Range("H43").Value = TD(vCol, 6).Value
                End With
            'End If
        End If
    End If
End Sub

Jean-Eric a écrit :

Bonjour,

Une proposition.

Les données Entreprises sont sous forme de tableau structuré dans une feuille distinctes (!?).

Cdlt.

Raphaël78120.xlsm

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TD As Range, vCol
    If Target.Address = "$H$39" Then
        Me.Range("H40,M40,H41,B43,H43").ClearContents
        If Not IsEmpty(Target) Then
            Set TD = Worksheets("Entreprises").Range("T_Entreprises")
            vCol = Application.Match(Target.Value, TD.Columns(1), 0)
            'If Not IsError(vCol) Then
                With Me
                    .Range("H40").Value = TD(vCol, 2).Value
                    .Range("M40").Value = TD(vCol, 3).Value
                    .Range("H41").Value = TD(vCol, 4).Value
                    .Range("B43").Value = TD(vCol, 5).Value
                    .Range("H43").Value = TD(vCol, 6).Value
                End With
            'End If
        End If
    End If
End Sub

Bonjour j'ai ajusté les quelques petits détails (pb de fusion de cellules) et cela marche ! Un grand merci. C'est ce que je souhaite (pour la 2ème partie de ma question).

Maintenant je vais joindre le fichier (pour eriic et vous tous) pour être plus clair. Pour répondre à ThauThème j'ai essayé ton code mais la fonction Raj me dit qu'elle n'est pas définit, j'ai donc du louper quelque chose. Je joint le fichier avec le nouveau code plus simple et vous me dites !

Petite info en H39 devant "société" on choisi donc l'entreprise et tout s'affiche automatiquement : Quand on sélectionne AUTRE dans les entreprises cela permet d'ajouter les informations dans le tableau contenant les données et donc cela les sauvegardes et cela est directement enregistrer dans la liste (grâce au code de Jean-Eric)

Donc Vous allez voir sur ce fichier tout fonctionne bien pour le premier tableau il faut donc que ça marche pour le 2eme tableau aussi (juste en dessous) et c'est là qu'est ma première question.

En vous remerciant énormément !

Raph