Copier des données d'un ligne où la valeur en colonne B = $cahier

**laura_duj** · 07/06/2016, 10h25

Bonjour,

j'ai fais un code qui me permet de rechercher une valeur entré dans une inputbox.
Si ce qui est entré dans l'inputbox correspond à une valeur de ma cellule B alors je
sélectionne la valeur en cellule A qui est le nom d'un fichier. J'ouvre ensuite ce fichier
et je recherche une valeur ($cahier) en colonne B. Si la valeur est présente alors je copie certaines
valeurs de cette ligne dans ma première feuille de mon classeur sinon j'affiche un message
d'erreur.

Le problème est que la valeur que je recherche dans la feuille ouverte est parfois présente sur
plusieurs lignes.
J'aimerais donc que mon programme récupère toutes les valeurs demandé lorsque $cahier est présent.
J'ai essayé avec plusieurs code mais impossible de trouver la solution.

Si quelqu'un pouvait m'aiguiller svp.

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
Sub recherche()
 
Dim i As Long
Dim j As Long
Dim l As Long
Dim k As Long
Dim req As String
Dim Fichier As String
Dim CheminFichier As String
Dim celluletrouvee As Range
Dim indice As String
 
CheminFichier = "C: ..."
 
re:
 
req = InputBox("Renseignez un nom")
 
If req = "" Then
    MsgBox "Vous n'avez rien saisie"
    GoTo re
End If
 
If req <> "" Then
 
Application.ScreenUpdating = False
 
i = 2
j = 2
l = 1
k = 16
 
    Do While Sheets("donnees").Cells(i, 2).Value <> ""
 
 
        If req = Sheets("donnees").Cells(i, 2).Value Then
 
            Fichier = Sheets("donnees").Cells(i, 1).Value
 
            Workbooks.Open (CheminFichier & Fichier)
 
                indice = "$cahier"
 
                 Set celluletrouvee = Range("B16:B100").Find(indice, lookat:=xlWhole)
 
                  Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, 5).Value = Workbooks("Programme.xlsm").Sheets("donnees").Cells(i, 1).Value
 
                   For Each cell In celluletrouvee
                       If cell.Value = indice Then
 
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, l).Value = Cells(k, 3).Value
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 1)).Value = Cells(k, 5).Value
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 2)).Value = Cells(k, 6).Value
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 3)).Value = Cells(k, 7).Value
 
                    l = l + 5
                    End If
                    Next cell
 
                    Workbooks(Fichier).Close (True)
                   j = j + 1
        End If
        i = i + 1
    Loop
 
end if
 
end sub