VBA condition et copie de ligne vers autre onglets

Bonjour,

Je suis plutôt novice sur ce langage. J'ai passé un long moment sur ce forum sans pouvoir réellement avoir trouvé une solution.

J'explique ma situation :

J'ai un fichier excel, j'ai sur la feuiille 1 une liste de personnes (environ 50) avec en colonne le nom, le prénom, l'adresse, l'adresse 2, code postal et la ville.

Je souhaite mettre un ImputBox qui va me chercher le nom de la personne. Grâce à ce critère je souhaiterais que cela me copie la ligne correspondante et la coller en feuille 2.

J'espère avoir été clair et que cela soit possible.

Merci de votre aide.

Bonjour,

A tester

A+

Ca marche niquel.

Merci beaucoup frangy

Etant donné mon enthousiaste vis à vis de la réponse précédente, je vais abuser de votre générosité.

Mettons que le problème précédent est résolu. Mon but final est de faire des étiquettes.

Colonne Nom, Colonne Prénom

Colonne Adresse

Colonne Adresse 2 (pour certains)

Colonne Code Postal, Colonne Ville

Voici la disposition finale que j'aimerais obtenir. Est ce possible?

Ci dessous la macro de base :

Sub Test()

Dim Valeur As String

Dim C As Range

Valeur = InputBox("Veuillez saisir le nom ATC.", "RECHERCHE")

Set C = Worksheets("Feuil1").Columns(2).Find(Valeur, , xlValues, xlWhole)

If Not C Is Nothing Then

With Worksheets("Feuil2")

C.Resize(1, 6).Copy .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(1)

.Activate

End With

End If

End Sub

Merci.

Il suffit de préciser l'emplacement des données à coller

Sub Test()
Dim Valeur As String
Dim C As Range
Dim LigneAjout As Long
    Valeur = InputBox("Veuillez saisir le nom ATC.", "RECHERCHE")
    Set C = Worksheets("Feuil1").Columns(2).Find(Valeur, , xlValues, xlWhole)
    If Not C Is Nothing Then
        With Worksheets("Feuil2")
            LigneAjout = .Range("A" & Rows.Count).End(xlUp).Offset(2).Row
            C.Copy .Range("A" & LigneAjout) 'Nom
            C.Offset(0, 1).Copy .Range("B" & LigneAjout) 'Prénom
            C.Offset(0, 2).Copy .Range("A" & LigneAjout + 1) 'Adresse 1
            C.Offset(0, 3).Copy .Range("A" & LigneAjout + 2) 'Adresse 2
            C.Offset(0, 4).Copy .Range("A" & LigneAjout + 3) 'CP
            C.Offset(0, 5).Copy .Range("B" & LigneAjout + 3) 'Ville
            .Activate
        End With
    End If
End Sub

A+

Ca paraît simple quand on nous donne la réponse. Ca reste de la pur logique certes mais encore faut-il connaitre les bases de ce langage.

En tout cas merci pour ce gain de temps Frangy.

A +