Mais là du coup ca ne me garde plus que les lignes avec "index de départ"
Normal faut recopier tout le code, pas simplement rajouter une ligne
solution1)
Sub recherche()
Sheets("Données").Activate
lignemax = Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Export").Activate
'**1ere recherche**
With Range("K:K")
Set cel = .Find(What:="RELEVE NORMALE", LookIn:=xlValues, lookat:=xlWhole)
If Not cel Is Nothing Then
Depart = cel.Address
Do
'MsgBox cel.Address
Cells(cel.Row, 11).Copy Worksheets("Données").Range("A" & lignemax) 'type releve
Cells(cel.Row, 12).Copy
Worksheets("Données").Range("B" & lignemax).PasteSpecial Paste:=xlPasteValues 'hc
Cells(cel.Row, 13).Copy
Worksheets("Données").Range("C" & lignemax).PasteSpecial Paste:=xlPasteValues 'hp
Cells(cel.Row, 6).Copy Worksheets("Données").Range("D" & lignemax) 'date
lignemax = lignemax + 1
Set cel = .FindNext(cel)
Loop While Depart <> cel.Address
End If
End With
'**2eme recherche**
With Range("K:K")
Set cel = .Find(What:="INDEX DE DEPART", LookIn:=xlValues, lookat:=xlWhole)
If Not cel Is Nothing Then
Depart = cel.Address
Do
'MsgBox cel.Address
Cells(cel.Row, 11).Copy Worksheets("Données").Range("A" & lignemax) 'type releve
Cells(cel.Row, 12).Copy
Worksheets("Données").Range("B" & lignemax).PasteSpecial Paste:=xlPasteValues 'hc
Cells(cel.Row, 13).Copy
Worksheets("Données").Range("C" & lignemax).PasteSpecial Paste:=xlPasteValues 'hp
Cells(cel.Row, 6).Copy Worksheets("Données").Range("D" & lignemax) 'date
lignemax = lignemax + 1
Set cel = .FindNext(cel)
Loop While Depart <> cel.Address
End If
End With
End Sub
Solution2)
Remplacer juste ca:
Set cel = .Find(What:=Sheets("Feuil1").range("A1"), LookIn:=xlValues, lookat:=xlWhole)
et dans la feuil1,cellule A1 tu crée une liste avec toutes les valeurs que tu peux rechercher.Normalement il mettra les recherches les unes en dessous des autres.