Données d'une même ligne sur une autre feuille

**MNAESSENS** · 27/05/2020, 17h31

Bonjour a tous !

Petite question

J'aimerais faire ceci :

J'ai ma feuille 1 qui contient des données telles que : nom , prenom , adresse email , societe , tel portable.

Ma question est celle-ci :

Sur une deuxieme feuille j'ai creer un tableau comme ca :

Nom : Capture.PNG
Affichages : 242
Taille : 25,2 Ko

Nom : Capture.PNG
Affichages : 242
Taille : 25,2 Ko

lorsque j'ai choisie mon fournisseur etc.. j'aimerais que lorsque j'appuie sur mon bouton "renseigner contact" la macro va rechercher (selon le fournisseur choisie) le contact correspondant ( donc nom ,prenom , adresse email , tel )

voici ma base de donnée pour vous donner une idée :

Nom : Capture2.PNG
Affichages : 262
Taille : 54,4 Ko

Nom : Capture2.PNG
Affichages : 262
Taille : 54,4 Ko

Voila , j’espère que j'ai réussi me faire comprendre

(je suis pas ouf en VBA mais mes collaborateurs utilisent ce fichier très souvent, d'où ma demande ^^ )

Invité · 28/05/2020, 04h04

Envoyé par MNAESSENS

Bonjour,

Par rapport à ce que vous décrivez et à ce qu'on voit à l'écran, il n'y a pas besoin de macro pour faire cela sauf si vous aviez plusieurs interlocuteurs pour une même société. Des RECHERCHEV suffisent pour alimenter vos zones puisque visiblement vos cellules fournisseurs sont liées à votre base de contacts.

**MNAESSENS** · 28/05/2020, 08h52

Bonjour et merci pour votre reponse

Le truc c'est que (je l'ai pas expliqué ^^ ) ensuite , une fois que les cases sont renseigner , la macro ouvre outlook , reprend les valeurs adresse email et envoie un mail ( a autant de destinataire que je rempli de ligne dans mon Excel ) , avec un corps de mail pré-défini qui change en fonction du fournisseur.

La date d'envoie du mail est ensuite ajouter automatiquement dans la colonne "consulté"
(il y a un petit code qui (pour savoir si il a deja envoyé un mail ) case consulté si vide = envoie de mail sinon next (en gros)

Mais comme ce morceau de code fonctionne bien j'ai pas besoin de le reprendre ^^

Il me manque juste mon premier pb ^^
Apres..... je pourrais utiliser mon "bouton" pour juste envoyé le mail.. et non pour allez rechercher les infos.

Invité · 28/05/2020, 10h20

Envoyé par MNAESSENS

Quel est votre code actuel ?
Avez-vous pensé à travailler avec un tableau structuré ?

**MNAESSENS** · 28/05/2020, 10h22

Vous allez pleurer avec mon code actuel ^^
Il n'a pas été fait par moi et il ne contient pas beaucoup de commentaires :/

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Sub RenseignerContacts()
 
Dim olApp As Outlook.Application
Dim dossierContacts As Outlook.MAPIFolder
Dim Contact As Outlook.ContactItem
Dim i As Integer, j As Integer, k As Integer, l As Integer, v As Integer
Dim a As Integer
 
Dim finput As FileDialog
Dim CheminDestination As String
 
Set finput = Application.FileDialog(msoFileDialogFilePicker)
MsgBox "Veuillez indiquer l'emplacement du CCTP."
finput.Show
 
Sheets("Feuil2").Cells(2, 7).Value = CStr(finput.SelectedItems(1))
 
 
For v = 13 To Range("A" & Rows.Count).End(xlUp).Row
    If Cells(v, 1).Value = "-" Then
        Rows(v).Select
        Selection.Delete Shift:=xlUp
    End If
Next v
 
Dim ListeContacts(15, 15) As String
 
 
Set olApp = New Outlook.Application
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
'Verifie si le dossier des contacts contient des éléments
If dossierContacts.Items.Count = 0 Then Exit Sub
 
 
For i = 13 To 200
    If Cells(i, 1).Value = "" Then Exit For
    If Cells(i, 5).Value <> "" Then
 
    Else
 
        If Cells(i, 1).Value <> "-" Then
            Erase ListeContacts
            k = 0
 
 
            For Each Contact In dossierContacts.Items
 
                If Cells(i, 4) = Contact.CompanyName Then
 
                    ListeContacts(k, 0) = Contact.FullName
                    ListeContacts(k, 1) = Contact.BusinessTelephoneNumber
                    ListeContacts(k, 2) = Contact.MobileTelephoneNumber
                    ListeContacts(k, 3) = Contact.Email1Address
 
                    k = k + 1
 
                End If
 
            Next Contact
 
            j = i
 
            For l = 0 To k - 1
 
                If l = 0 Then
                    Cells(j, 5).Value = ListeContacts(l, 0)
                    Cells(j, 7).Value = ListeContacts(l, 1)
                    Cells(j, 8).Value = ListeContacts(l, 2)
                    Cells(j, 6).Value = ListeContacts(l, 3)
 
                Else
                    j = j + 1
                    Rows(i).Select
                    Selection.Copy
                    Rows(j).Select
                    Selection.Insert Shift:=xlDown
                    Application.CutCopyMode = False
 
                    Cells(j, 5).Value = ListeContacts(l, 0)
                    Cells(j, 7).Value = ListeContacts(l, 1)
                    Cells(j, 8).Value = ListeContacts(l, 2)
                    Cells(j, 6).Value = ListeContacts(l, 3)
                    Cells(j, 1).Value = "-"
                    Cells(j, 2).Value = "-"
                    Cells(j, 3).Value = "-"
 
                End If
 
            Next l
 
        End If
 
    End If
 
    If Sheets("Fournisseurs").Cells(i, 9).Value = "" Then
        Dim Corps As String
        Corps = "Bonjour," 'début du message
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & "Je vous contacte concernant le projet repris en objet. Pouvez-vous me chiffrer les équipements ou prestations décrit(e)s dans le CCTP ci-joint (voir pages ci-dessous) ?"
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & Sheets("Fournisseurs").Cells(i, 2).Value
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        If Sheets("Fournisseurs").Cells(i, 12).Value <> "" Then
            Corps = Corps & Sheets("Fournisseurs").Cells(i, 12).Value
            Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
            Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        End If
        Corps = Corps & "Merci d'avance,"
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & "Cordialement."
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & "Alexis Nicotera - Ingénieur Etudes Projets - Santerne Fluides"
        Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
        Corps = Corps & "Mobile : 07 63 87 53 47"
 
        If Sheets("Fournisseurs").Cells(i, 13).Value = "" And Sheets("Fournisseurs").Cells(i, 14).Value = "" And Sheets("Fournisseurs").Cells(i, 15).Value = "" Then
            Call EnvoyerEmail(Sheets("Fournisseurs").Range("B4").Value & " - " & Sheets("Fournisseurs").Cells(i, 1).Value, Sheets("Fournisseurs").Cells(i, 6).Value, Corps, Sheets("Feuil2").Range("G2").Value)
        End If
 
        If Sheets("Fournisseurs").Cells(i, 13).Value <> "" And Sheets("Fournisseurs").Cells(i, 14).Value = "" And Sheets("Fournisseurs").Cells(i, 15).Value = "" Then
            Call EnvoyerEmail(Sheets("Fournisseurs").Range("B4").Value & " - " & Sheets("Fournisseurs").Cells(i, 1).Value, Sheets("Fournisseurs").Cells(i, 6).Value, Corps, Sheets("Feuil2").Range("G2").Value, Sheets("Fournisseurs").Cells(i, 13).Value)
        End If
 
        If Sheets("Fournisseurs").Cells(i, 13).Value <> "" And Sheets("Fournisseurs").Cells(i, 14).Value <> "" And Sheets("Fournisseurs").Cells(i, 15).Value = "" Then
            Call EnvoyerEmail(Sheets("Fournisseurs").Range("B4").Value & " - " & Sheets("Fournisseurs").Cells(i, 1).Value, Sheets("Fournisseurs").Cells(i, 6).Value, Corps, Sheets("Feuil2").Range("G2").Value, Sheets("Fournisseurs").Cells(i, 13).Value, Sheets("Fournisseurs").Cells(i, 14).Value)
        End If
 
        If Sheets("Fournisseurs").Cells(i, 13).Value <> "" And Sheets("Fournisseurs").Cells(i, 14).Value <> "" And Sheets("Fournisseurs").Cells(i, 15).Value <> "" Then
            Call EnvoyerEmail(Sheets("Fournisseurs").Range("B4").Value & " - " & Sheets("Fournisseurs").Cells(i, 1).Value, Sheets("Fournisseurs").Cells(13, 6).Value, Corps, Sheets("Feuil2").Range("G2").Value, Sheets("Fournisseurs").Cells(i, 13).Value, Sheets("Fournisseurs").Cells(i, 14).Value, Sheets("Fournisseurs").Cells(i, 15).Value)
        End If
 
        Sheets("Fournisseurs").Cells(i, 9).Value = Date
 
    End If
Next i
 
Dim Repertoire As FileDialog
 
MsgBox "Veuillez indiquer l'emplacement du dossier Consultations ?"
 
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
 
If Repertoire.SelectedItems.Count > 0 Then _
    CheminDestination = Repertoire.SelectedItems(1)
 
 
For i = 13 To Sheets("Fournisseurs").Range("A" & Rows.Count).End(xlUp).Row
 
    If Sheets("Fournisseurs").Cells(i, 4).Value <> "" And Sheets("Fournisseurs").Cells(i, 9).Value Then
        MkDir (CStr(CheminDestination) & "/" & Sheets("Fournisseurs").Cells(i, 4).Value & "/")
    End If
 
 
Next i
 
 
 
MsgBox "Consultations envoyées!"
End Sub

Vraiment désolé ^^

**MNAESSENS** · 28/05/2020, 10h23

Envoyé par Eric KERGRESSE

Quel est votre code actuel ?
Avez-vous pensé à travailler avec un tableau structuré ?

Que voulez vous dire par tableau structuré ?

Invité · 28/05/2020, 10h30

Envoyé par MNAESSENS

Que voulez vous dire par tableau structuré ?

C'est comme votre base clients. Il vous faut plutôt travailler avec ce genre de tableau, c'est beaucoup plus facile à exploiter ensuite, plus fiable et les formules plus lisibles.
Pour cela, vous sélectionnez tout votre tableau et dans le ruban d'Excel Insérer - Tableau.

Sinon par rapport à la réponse précédente, quand vous postez du code, vous le sélectionnez et vous cliquez sur le bouton #. Il n'est pas trop tard pour le faire...

Invité · 28/05/2020, 11h19

Envoyé par MNAESSENS

Je persiste, pas besoin de macro, dès que vous avez choisi le client, vous pouvez récupérer les différentes valeurs par des RECHERCHEV. Il vous suffit ensuite d'utiliser ces valeurs comme votre code le fait / onglet Fournissseurs.

**MNAESSENS** · 28/05/2020, 11h46

ok merci beaucoup !!

Je vais tenter un truc pour qu'il aille rechercher les info dans l'autre feuille , si je bug je reviens vers vous ( si toutefois vous m'accorder quelques minutes de votre temps supplementaire :p )

Merci d'avance a vous et merci de vos reponse

Invité · 28/05/2020, 11h53

Envoyé par MNAESSENS

J'ai l'impression qu'il vous manque un champ numéro d'affaire. C'est ce numéro qui vous permettra de récupérer vos informations pour envoyer votre mail. Dans ce cas, il ne faudrait pas commencer votre tableau en ligne 1 pour avoir la possibilité de choisir votre numéro.

**MNAESSENS** · 28/05/2020, 12h18

Envoyé par Eric KERGRESSE

J'ai l'impression qu'il vous manque un champ numéro d'affaire. C'est ce numéro qui vous permettra de récupérer vos informations pour envoyer votre mail. Dans ce cas, il ne faudrait pas commencer votre tableau en ligne 1 pour avoir la possibilité de choisir votre numéro.

Qu'est ce qui vous fais dire cela ?

**MNAESSENS** · 28/05/2020, 15h32

J'aimerais faire ceci :

J'aimerais que quand la cellule D13 de ma feuille "founisseurs" contient une valeur qui correspond a une des valeurs de la collonne F de ma feuille 1 , j'aimerais que les valeurs des celulles de la collone A B et C correspondant a la meme ligne qu le fournisseur choisie en Feuill1 soit copier sur la ligne de la feuille fournisseurs

Pour imagé voici :

Nom : macro.png
Affichages : 204
Taille : 225,0 Ko

Nom : macro.png
Affichages : 204
Taille : 225,0 Ko

Donc pour ré expliquer (lol)
Sur la fenetre de gauche , je choisie mon fournisseurs.
dans La ligne correspondant au fournisseurs choisie (fenetre de droite) j'aimerais que nom , prenom , email etc... se remonte dans les cellules de la fenetre de gauche.

(pas super bien expliquer mais j'essaye lol )

La solution peut etre macro VBA ou formule direct en cellule ( le plus simple haha )

Merci d'avance <3<3

Invité · 28/05/2020, 15h45

Envoyé par MNAESSENS

La colonne de référence (Société) n'étant pas la première dans votre BDD, il vous faudra utiliser une combinaison des fonctions INDEX, EQUIV
Un exemple, dans cette discussion (pas forcément adaptée à votre configuration mais suffisante pour comprendre)

https://www.developpez.net/forums/d1...ncrementation/

Si vous n'y arrivez pas, mettez en ligne un fichier sans données confidentielles avec vos deux tables, s'il contient des macros, zipez-le.

**MNAESSENS** · 28/05/2020, 16h34

Envoyé par Eric KERGRESSE

La colonne de référence (Société) n'étant pas la première dans votre BDD, il vous faudra utiliser une combinaison des fonctions INDEX, EQUIV
Un exemple, dans cette discussion (pas forcément adaptée à votre configuration mais suffisante pour comprendre)

https://www.developpez.net/forums/d1...ncrementation/

Si vous n'y arrivez pas, mettez en ligne un fichier sans données confidentielles avec vos deux tables, s'il contient des macros, zipez-le.

Et si je switch ma colonne "Societe en 1er collone ?

Invité · 28/05/2020, 16h35

Envoyé par MNAESSENS

Et si je switch ma colonne "Societe en 1er collone ?

Vous pourrez utiliser des fonctions RechercheV

**MNAESSENS** · 28/05/2020, 16h37

D'accord , bon je vais essayer comme ca !

Merci

**MNAESSENS** · 28/05/2020, 17h07

Bon .. ^^
(le chiant est de retour ^^)

j'ai reussi a faire la rechercheV qui fonctionne trés bien merci !

MAIS !! petit soucis haha (sinon ce n'est pas drole ^^ )

Si je dois renseigner une 2eme ligne , j'appuie sur un bouton qui me copie ma ligne 12 et l'insere a la suite avec cette macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub NouveauContact()
Dim i As Integer
Dim DerLig As Integer
  Rows("12").Select
   Selection.Copy
   Rows(Range("A" & Rows.Count).End(xlUp).Row + 1).Select
   Selection.PasteSpecial
   Application.CutCopyMode = False
 DerLig = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To 15
Cells(DerLig, i).Value = ""
Next i
 
Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1).Select

Est-ce possible de dire a la macro quand il recopie ma ligne d'inclure les formule RECHERCHEV afin que les formule se recopie egalement. (sinon mes collaborateurs vont devoir marquer la fonction RECHERCHEV a chaque fois et sa va pas trop leur plaire haha ^^ )

merci d'avance !

Invité · 28/05/2020, 17h16

Envoyé par MNAESSENS

Visiblement, vous n'avez pas transformé votre tableau en tableau structuré.... Vous devriez essayer juste pour voir ce que cela fait.

Invité · 28/05/2020, 17h31

Envoyé par MNAESSENS

Un petit exemple de tableau structuré : soit on clique sur le bouton, soit clic droit sur le tableau cible et ajouter ligne...

Que se passe-t-il au niveau de la formule ?