Discussion :

[Biggy95]

Bonjour,

J'ai un souci assez urgent à traitet j'aimerais votre aide.

Je l'explique:



Les feuilles contenant les données à rechercher sont "Feuil1", "Feuil2" et "Feuil3".

La feuille "Source" est celle contenant les resultats cherchés dans la colonne H

Dans les 3 premières feuilles il y a des colonnes différentes mais une seule d'entre elles contient les données à rechercher (ce sont à chaque fois des adresses mail):

Dans la feuille "Feuil1", c'est la colonne D qui contient les adresses mail

Dans la feuille "Feuil2" c'est la colonne U qui contient les adresses mail

Dans "Feuil3" c'est la colonne K qui contient les adresses mail

Le but est donc de comparer ces adresses mails à celles de la feuille "Source" en colonne H. Si une adresse de meme valeur est retrouvée alors recopier les valeurs des colonnes A, B et D de la même feuille "Source" dans la feuille "Récap"

je voudrais que la zone de collage de la feuille "Récap" soit vidée (si elle contient les données) avant de lancer la macro et faire un collage par ordre alphabetique de tous les résultats provenant de la feuille "Source"

Je ne sais pas si c'est assez clair. Ci-joint un fichier exemple.

Merci d'avance

[ARTURO83]

Bonjour,

Ceci
Pièce jointe 582938

le code

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
Sub Recup_Donnees()
    Dim f1 As Worksheet, f4 As Worksheet, f5 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f4 As Long, Col As Long, i As Long, f As Long, Lig As Long
    Dim Mail As String
 
    Application.ScreenUpdating = False
    Set f4 = Sheets("Source")
    Set f5 = Sheets("Récap")
    f5.Cells.ClearContents
    DerLig_f4 = f4.Range("A" & Rows.Count).End(xlUp).Row
    Lig = 2
    For i = 2 To DerLig_f4
        If f4.Cells(i, "F") <> "" And f4.Cells(i, "F") <> "@" Then
            Mail = f4.Cells(i, "F")
            For f = 1 To 3
                Select Case f
                    Case 1
                        Col = 4
                    Case 2
                        Col = 21
                    Case 3
                        Col = 11
                End Select
                Set f1 = Sheets(f)
                DerLig_f1 = f1.Cells(Rows.Count, Col).End(xlUp).Row
                If Application.WorksheetFunction.CountIf(f1.Range(f1.Cells(1, Col), f1.Cells(DerLig_f1, Col)), Mail) <> 0 Then
                    f5.Range(f5.Cells(Lig, "A"), f5.Cells(Lig, "B")).Value = f4.Range(f4.Cells(i, "A"), f4.Cells(i, "B")).Value
                    f5.Cells(Lig, "C").Value = f4.Cells(i, "D").Value
                    Lig = Lig + 1
                    Exit For
                End If
            Next f
        End If
    Next i
    f5.Range("A1:C1").Value = Array("Poste", "Résidence", "Matricule")
    Set f1 = Nothing
    Set f4 = Nothing
    Set f5 = Nothing
End Sub

Cdlt

[Pierre Fauconnier]

Salut.

Si j'ai bien compris ta demande, ça prend 3 minutes avec Power Query:

• Ajout des 4 tableaux à la solution Power query
• Fusion de Source et Feuil1 dans une nouvelle requête;
• Dans cette nouvelle requête, fusion avec Feuil2 puis avec Feuil3;
• Récup des colonnes de mail;
• Ajout d'une colonne formulée pour tester que l'on a une adresse mail;
• Suppression des colonnes superflues;
• Renvoi dans excel.

Cela dit, je ne comprends pas ton histoire de colonne H qui contiendrait le résultat (quel résultat?) puisque tu demandes de récupérer les données dans une feuille Recap et que, perso, je ne vois pas bien le lien entre la colonne H de la source et les colonnes des autres feuilles... Pourrais-tu montrer à quoi doit ressembler ton récap avec les données présentes dans les autres feuilles?

[Biggy95]

Merci ARTURO8

La macro fonction bien mais seulement lorsque je nomme mes 3 premieres feuilles Feuil1, Feuil2 et Feuil 3

Qu'est-ce qui changerait si les feuilles portent par exemple respecticement les noms "Département", Région", "Commune"?

Merci

[Biggy95]

Pierre Fauconnier,

Je me suis trompé mais les adresses sont plutot rangées dans la colonne F. J'ai dû légèrement modifié le code de ARTURO8 en rentrant le bon nom de colonne dans mon fichier

[ARTURO83]

La macro fonction bien mais seulement lorsque je nomme mes 3 premieres feuilles Feuil1, Feuil2 et Feuil 3

Qu'est-ce qui changerait si les feuilles portent par exemple respecticement les noms "Département", Région", "Commune"?

Il ne se passerait rien, vu que l'on prend le N° de la feuille et pas son nom

[Biggy95]

Ah oui je me suis planté. En effet elle me donne le résultat voulu mais j'ai un message Erreur d'exécution 13: Incompatibilité type à la fin

[Pierre Fauconnier]

Ok.

tu devrais travailler avec des tableaux structurés (voir mon tuto à ce sujet). c'est à mon sens incontournable en XL365. Ca simplifierait ton approche et ton code, pour autant que tu veuilles vraiment utiliser le VBA pour ce genre de traitement, ce qui serait dommage car Power Query a justement été créé pour se dispenser de VBA.

Est-ce que le tableau récap suivant est bien ce que tu souhaites par rapport aux données que tu as fournies dans ton classeur initial?

[Pierre Fauconnier]

Si vraiment tu veux du VBA, voici ce que je te propose (voir ma signature: Quand on programme en VBA pour Excel, on pense d'abord Excel avant de penser VBA):


Le code que je te donne ici ne s'appuie pas sur les tableaux structurés, mais ce serait mieux si tes données étaient organisées en tableaux structurés, pour dépouiller le code des emplacements "en dur" exprimés ici.

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 Test()
  Dim CountOf As Long
 
  Application.ScreenUpdating = False
  Feuil5.Cells.ClearContents
  Feuil1.Range("a1").CurrentRegion.Copy Destination:=Feuil5.Range("a1")
  Feuil5.Range("i2:i" & Feuil5.Range("a1").CurrentRegion.Rows.Count).Formula = _
    "=(COUNTIFS(Feuil1!D:D,Source!F2)+COUNTIFS(Feuil2!U:U,F2)+COUNTIFS(Feuil3!K:K,F2))>0"
  Feuil5.Range("a1").CurrentRegion.Sort key1:=Feuil5.Range("i1"), order1:=xlDescending, Header:=xlYes
  CountOf = Application.CountIfs(Feuil5.Range("i:i"), True) + 1
  Feuil5.Range("a2")(CountOf).Resize(1048576 - CountOf).EntireRow.Delete
  Feuil5.Range("c:c,e:i").EntireColumn.Delete
  Application.ScreenUpdating = True
End Sub

Mais je pense vraiment que cela vaut la peine d'investir un peu de temps à apprendre Power Query. Ca permet de rester en XLSX si tu n'as pas besoin de VBA pour autre chose dans ton classeur.

[Biggy95]

Merci à vous pour votre réactivité. Je teste les différents codes et je reviens vers vous dasn la soirée