Recherche Find et FindNext

**chevrotine56** · 30/11/2022, 09h22

Bonjour à tous,

J'ai 2 classeurs, je voudrais rechercher dans le classeur "B" les lignes qui correspondent a certaine valeur contenue dans "A" et je veux copier ces données de "B" vers "A"
Pour cela j'utilise une fonction Find pour chercher les données, mais je n'arrive pas a utiliser correctement la fonction FindNext.
Le nombre de ligne ayant la bonne valeur est aléatoire a chaque recherche.

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
 
Public Emplacement_dossier As String
Public WB_compil As Workbook
Public Cpt1 As Long
Public Cpt2 As Long
Public Cpt3 As Long
Public Fichier_dest As String
Public fichier_MH As String
Public MH_en_cours As Workbook
Public cle_cours As Variant
Public Rng As Range
Public Nomenclature_en_cours As Worksheet
Public compil_art_ss_opé As Worksheet
Public Derligne As Long
Public WB_nommenclature As Workbook
Public Ligne_Nomenclature As Integer
 
Sub compil_composants_composé()
 
    '-----------------------------------------------
    'permet de compiler la liste des articles non option de tout les scénarios extrait et mis en forme dans
    'Y:\Fichiers communs\Service Technique\Méthodes\03 - Projets et études\Projets 20\20 - PRAT - Atelier\23PRAT60-M - Etude KANBAN MIL\Analyse scénarion MH\
    ' Objectif : Lister les article KANBAN
 
Application.Calculation = xlManual 'calcul en mode manuel
Application.ScreenUpdating = False  'ne pas mettre a jour l'ecran
 
Emplacement_dossier = ActiveWorkbook.Path
 
    Set WB_compil = ActiveWorkbook
    Set compil_art_ss_opé = ActiveSheet
Derligne = compil_art_ss_opé.Cells(Rows.Count, 1).End(xlUp).Row
 
Fichier_dest = "\\192.168.1.5\Fichiers communs\Service Technique\Méthodes\03 - Projets et études\Projets 20\20 - PRAT - Atelier\23PRAT60-M - Etude KANBAN MIL\Analyse scénarion MH\"
 
fichier_MH = Dir(Fichier_dest & "nomenclature SE avec num OPE.xlsm")
 
Workbooks.Open Fichier_dest & fichier_MH
    Set MH_en_cours = ActiveWorkbook
Sheets(1).Select
    Set Nomenclature_en_cours = ActiveSheet
Cells(1, 1).Select
 
Derligne2 = Nomenclature_en_cours.Cells(Rows.Count, 1).End(xlUp).Row
 
WB_compil.Activate
    For Cpt2 = Derligne To 2 Step -1
        cle_cours = compil_art_ss_opé.Cells(Cpt2, 2).Value
 
        With MH_en_cours.Sheets(1).Range("C:C")
            Set Rng = .Find(What:=cle_cours, LookIn:=xlValues)
                If Not Rng Is Nothing Then 'Si la donnée existe enregistre le numero de la ligne
                    Ligne_Nomenclature = Rng.Row
                    WB_compil.Sheets(1).Rows(Cpt2 + 1).Insert
 
                    Cells(Cpt2 + 1, 1) = Cells(Cpt2, 1).Value
                    Cells(Cpt2 + 1, 2) = Cells(Cpt2, 2).Value
                    compil_art_ss_opé.Cells(Cpt2 + 1, 3).Value = Nomenclature_en_cours.Cells(Ligne_Nomenclature, 5)
                    compil_art_ss_opé.Cells(Cpt2 + 1, 4).Value = Nomenclature_en_cours.Cells(Ligne_Nomenclature, 6)
                    compil_art_ss_opé.Cells(Cpt2 + 1, 5).Value = Nomenclature_en_cours.Cells(Ligne_Nomenclature, 25)
 
                Do
                    Set cle_cours = .FindNext(cle_cours)
                Loop While Not cle_cours Is Nothing
                End If
 
        End With
 
    Next
 
End Sub

Une idée de comment faire?

merci

**EricDgn** · 01/12/2022, 01h10

Bonjour,

Voir si ceci ne conviendrait pas (code non testé):

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
Option Explicit
 
Sub compil_composants_composé()
    ' compile la liste des articles non option de tout les scénarios extrait et mis en forme dans
    ' Y:\Fichiers communs\Service Technique\Méthodes\03 - Projets et études\Projets 20\20 - PRAT - Atelier\23PRAT60-M - Etude KANBAN MIL\Analyse scénarion MH\
    ' Objectif : Lister les article KANBAN
    Dim Fichier_dest As String, Derligne As Long, Cpt2 As Long, cle_cours As String
    Dim Nomenclature_en_cours As Worksheet, Rng As Range, R01 As Long, Ligne_Nomenclature As Long
    Application.Calculation = xlManual  'calcul en mode manuel
    Application.ScreenUpdating = False  'ne pas mettre a jour l'ecran
 
    Fichier_dest = "\\192.168.1.5\Fichiers communs\Service Technique\Méthodes\03 - Projets et études\Projets 20\20 - PRAT - Atelier\23PRAT60-M - Etude KANBAN MIL\Analyse scénarion MH\"
    Workbooks.Open Fichier_dest & "nomenclature SE avec num OPE.xlsm"
    Set Nomenclature_en_cours = ActiveWorkbook.Sheets(1)
 
    ThisWorkbook.Activate
    Derligne = Cells(Rows.Count, 1).End(xlUp).Row
 
    With Nomenclature_en_cours.Range("C:C")
        For Cpt2 = Derligne To 2 Step -1
            cle_cours = Cells(Cpt2, 2).Value
            Set Rng = .Find(What:=cle_cours, LookIn:=xlValues)
            If Not Rng Is Nothing Then
                '--- première occurrence trouvée
                R01 = Rng.Row
                Do
                    Ligne_Nomenclature = Rng.Row
                    Rows(Cpt2 + 1).Insert
                    Cells(Cpt2 + 1, 1) = Cells(Cpt2, 1)
                    Cells(Cpt2 + 1, 2) = Cells(Cpt2, 2)
                    Cells(Cpt2 + 1, 3).Value = Nomenclature_en_cours.Cells(Ligne_Nomenclature, 5)
                    Cells(Cpt2 + 1, 4).Value = Nomenclature_en_cours.Cells(Ligne_Nomenclature, 6)
                    Cells(Cpt2 + 1, 5).Value = Nomenclature_en_cours.Cells(Ligne_Nomenclature, 25)
                    Set Rng = .FindNext(Rng)    '--- occurrence suivante trouvée
                Loop Until Rng.Row = R01        '--- revenu sur la première occurence
            End If
        Next
    End With
 
    Set Nomenclature_en_cours = Nothing
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

Bien regarder comment fonctionne FindNext (voir dans l'aide d'Excel). Le code proposé ne peut être utilisé que si l'on est certain que le texte recherché ne peut pas se trouver plusieurs fois dans une même cellule.

Cordialement.