Bonjour,
après avoir lu beacoup de sujet sur le forum, je me vois contrainte de vous demandé de l'aide.
J'ai besoin, suite à ma macro recherche (qui fonctionne très bien), d'afficher uniquement les titres du tableau de la recherche et non tous.
j'utilise ce code pour l'affichage des titres
voici mon code en entier
merci d'avance pour votre aide
après avoir lu beacoup de sujet sur le forum, je me vois contrainte de vous demandé de l'aide.
J'ai besoin, suite à ma macro recherche (qui fonctionne très bien), d'afficher uniquement les titres du tableau de la recherche et non tous.
j'utilise ce code pour l'affichage des titres
Code:
Set R = S.Range(S.Cells(2, 1), S.Cells(UBound(T, 2), UBound(T, 1)))
voici mon code en entier
Code:
Sub LignesMotRecherche()
'
' LignesMotRecheche Macro
' Macro enregistrée le 22/07/2011 par val
Dim S As Worksheet
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("Rechercher pièces en magasin", "Lignes contenant le mot recherché")
If rep = False Or rep = "" Then Exit Sub
B$ = LCase(rep)
Set R = ThisWorkbook.Sheets("base").Columns("A")
Set R = ThisWorkbook.Sheets("base").Columns("H:N")
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
Set S = Sheets("RECHERCHE")
S.Rows(1).Value = Sheets("base").Rows(1).Value
Set R = S.Range(S.Cells(2, 1), S.Cells(UBound(T, 2), UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
End If
End Sub
merci d'avance pour votre aide