Sélection et copie ligne d'un onglet à un autre

[Luc MOUNY]

Bonsoir à tous,

Me revoilà, j'ai réussi à bidouiller une macro, en partant d'articles de divers sites. Cette macro ne me donne pas entière satisfaction, la recherche s'établit sur l'ensemble des cellules de l'onglet "Recap".
Dans l'état actuel des choses, si le nom de la personne recherchée figure également dans un nom de rue ou de ville, toutes les lignes sont sélectionnées et collées dans l'onglet "Relai".
Voir l'exemple avec le nom ROY

Vous trouverez de plus amples renseignements, sur mon problème dans le fichier joint.

Je remercie par avance les forts en VBA qui voudrons bien m'aider.

 

[Compte Supprimé 979]

Bonjour Luc,

Voici une possibilité de code qui va bien

Sub Cherche_Copie_Ligne()
  Dim strSearch
  Dim DLig As Long, Lig As Long
  ' Désactiver l'affichage écran
  Application.ScreenUpdating = False
  ' Nom à chercher
  strSearch = Application.InputBox("Nom de l'adhérent")
  ' Avec la feuille
  With Sheets("Recap")
    ' DErnière ligne du tableau
    DLig = .Range("C" & Rows.Count).End(xlUp).Row
    ' On boucle sur chaque ligne de l'onglet
    For Lig = 1 To DLig
      ' Est-que le nom est contenu dans la cellule
      If .Range("C" & Lig) Like "*" & strSearch & "*" Then
        .Rows(Lig).Copy Sheets("Relai").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      End If
    Next Lig
  End With
  ' Réactiver l'affichage écran
  Application.ScreenUpdating = True
End Sub

A+

 

[job75]

Bonjour Luc MOUNY, Bruno,

Avec un tableau VBA c'est plus rapide :

Sub Cherche_Copie_Ligne()
Dim strSearch$, colsearch%, ncol%, tablo, n&, i&, j%
strSearch = LCase(Application.InputBox("Nom de l'adhérent"))
If strSearch = "" Then Exit Sub
With Sheets("Recap").[A1].CurrentRegion 'à adapter
    colsearch = 3 'colonne de recherche, à adapter
    ncol = .Columns.Count
    If ncol < colsearch Then ncol = colsearch
    If ncol = 1 Then ncol = 2
    tablo = .Resize(, ncol) 'matrice, plus rapide
End With
n = 1
For i = 2 To UBound(tablo)
    If InStr(LCase(tablo(i, colsearch)), strSearch) Then
        n = n + 1
        For j = 1 To ncol
            tablo(n, j) = tablo(i, j)
        Next
    End If
Next
'---restitution---
Application.ScreenUpdating = False
With Sheets("Relai")
    If .FilterMode Then .ShowAllData 'si la feulle est filtrée
    .[A1].CurrentRegion.ClearContents 'RAZ
    .[A1].Resize(n, ncol) = tablo
    .Columns(1).Resize(, ncol).AutoFit 'ajustement largeur
    With .UsedRange: End With 'actualise les barres de défilement
    .Activate 'facultatif
End With
End Sub

Bonne journée.

 

[Luc MOUNY]

Bonjour Bruno, bonjour Job75 Bonjour à tout le forum.
Merci à tous les deux, de vous être manifesté aussi rapidement, vos deux solutions fonctionnent, avec un léger avantage à la macro de Job75, qui permet la saisie en majuscules ou minuscules, la macro de Bruno, elle ne fonctionne qu'en majuscules, ceci est un détail.
Il me reste à tester sur mon gros fichier.
Mon fichier totalise maintenant une trentaine de macros, jusqu'ici, j'arrivais à m'en sortir, mais j'avais vraiment des difficulté avec les noms composés.

Messieurs, je vous tire mon chapeau...

Vous avez résolu mon problème et ce, très rapidement. Je ne pensais pas que les réponses pouvaient être aussi rapides sur le forum. Ce n'est pas étonnant que Excel-Download.com soit autant sollicité.

Merci encore à tous.

 

[Compte Supprimé 979]

Luc MOUNY et ce n'est pas le seul comme ça