affichage titre et masquer colonne

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

breizhkar

XLDnaute Nouveau
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
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
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
531
Réponses
4
Affichages
400
Réponses
10
Affichages
418
  • Question Question
Microsoft 365 Erreur UBound
Réponses
4
Affichages
176
Réponses
8
Affichages
242
Réponses
5
Affichages
372
Retour