D
darib52
Guest
bonjour à tous,
j'ai récupéré la macro ci-dessous.
et je voudrais qu'elle oriente sa recherche uniquement sur la feuille "paiement" et la recherche des lignes à copier en fonction du libellé trouvé dans la seule colonne "c".
l'un d'entre vous aurait-il la bonté d'adapter le code ?
merci d'avance.
Sub LignesMotRecheche()
Dim rep
Dim R As Range
Dim var
Dim dep&
Dim i&
Dim j&
Dim k&
Dim cpt&
Dim T()
Dim A$
Dim B$
rep = Application.InputBox("Tapez le mot à rechercher", "Lignes contenant le mot recherché")
If rep = False Or rep = "" Then Exit Sub
B$ = LCase(rep)
Set R = ActiveSheet.UsedRange
dep& = R.Row
var = R
For i& = 1 To UBound(var, 1)
For j& = 1 To UBound(var, 2)
A$ = LCase(Trim(var(i&, j&))) 'commodité d'écriture
If InStr(1, A$, B$) > 0 Then
cpt& = cpt& + 1
ReDim Preserve T(1 To UBound(var, 2) + 1, 1 To cpt&)
T(1, cpt&) = i& + dep& - 1
For k& = 1 To UBound(var, 2)
T(k& + 1, cpt&) = var(i&, k&)
Next k&
Exit For
End If
Next j&
Next i&
If cpt& = 0 Then
MsgBox "Aucune occurence de ''" & rep & "'' n'a été trouvée."
Exit Sub
Else
Sheets("feuil2").Select
Set R = Range(Cells(3, 1), Cells(UBound(T, 2), UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
End If
End Sub
j'ai récupéré la macro ci-dessous.
et je voudrais qu'elle oriente sa recherche uniquement sur la feuille "paiement" et la recherche des lignes à copier en fonction du libellé trouvé dans la seule colonne "c".
l'un d'entre vous aurait-il la bonté d'adapter le code ?
merci d'avance.
Sub LignesMotRecheche()
Dim rep
Dim R As Range
Dim var
Dim dep&
Dim i&
Dim j&
Dim k&
Dim cpt&
Dim T()
Dim A$
Dim B$
rep = Application.InputBox("Tapez le mot à rechercher", "Lignes contenant le mot recherché")
If rep = False Or rep = "" Then Exit Sub
B$ = LCase(rep)
Set R = ActiveSheet.UsedRange
dep& = R.Row
var = R
For i& = 1 To UBound(var, 1)
For j& = 1 To UBound(var, 2)
A$ = LCase(Trim(var(i&, j&))) 'commodité d'écriture
If InStr(1, A$, B$) > 0 Then
cpt& = cpt& + 1
ReDim Preserve T(1 To UBound(var, 2) + 1, 1 To cpt&)
T(1, cpt&) = i& + dep& - 1
For k& = 1 To UBound(var, 2)
T(k& + 1, cpt&) = var(i&, k&)
Next k&
Exit For
End If
Next j&
Next i&
If cpt& = 0 Then
MsgBox "Aucune occurence de ''" & rep & "'' n'a été trouvée."
Exit Sub
Else
Sheets("feuil2").Select
Set R = Range(Cells(3, 1), Cells(UBound(T, 2), UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
End If
End Sub