Copier coller ligne active

Salut a tous
après plusieurs recherche sur internet, divers forum et des exemple tester par dizaines...
je m'en remet à vous pour mon petit pb:
Tout d'abord (je suis en feuil1)
je sélectionne ma liste dans la colonne A (end xl.down)
je compare avec la colonne A si la chaine recherché est existante (Instr,val,vcellule)
si c est le cas,
je dois la copier la ligne active dans la 1ère ligne libre de ma feuil2 (copier/coller)
puis j'effectue ceci avec toute les cellules de ma sélection: (Création d'une boucle)
(for each vcellule in selection....Next)

Je n'arrive pas a copier coller.... Si je n'ai pas d'erreur en tout genre, je n'ai que des lignes blanches

Le but final est d'alimenter un listbox (Filtrer une liste et l'afficher)

Ps autre point qui alourdit mon programme:
j'incrémente une liste qui peut être vide à la base. le pb c est qu'avec la fonction:
end xl down. mes trois premières lignes doivent être remplie sinon sa bug.
Quelqu'un connait il une solution pour sélectionner une liste avec xl up

merci d'avance pour ces pb
sebnormand

3 réponses

  1. Contributeur
    Bonjour,
    quel est la hauteur de colonne= 100 lignes, 1000, 10000 ?
    combien de colonne sont copiées (plutôt que copier b^tement une ligne)
    1. salut
      merci de regarder mes soucis^^
      je vais de la colonne A à L
      et j'ai environ 300 lignes
      cela peut augmenter
      1. Contributeur
        Bonjour,

        D'après ton 1° message, j'ai donc considéré qu'on cherchait à partir de la ligne 1 et que l'on reportait à partir de la ligne 2 du sheets(2)

        la macro est paramétrée pour permettre un changement du mot cherché
        Option Explicit

        Sub copier_si(motcherche)
        Dim Nbre As Integer, Lig As Long, Cptr As Integer
        Dim Ligvid As Integer, Paquet()
        Application.ScreenUpdating = False
        Sheets(2).Range("A1:L500").ClearContents
        With Sheets(1)
        Nbre = Application.CountIf(.Columns("A"), "*" & motcherche & "*")
        Lig = .Cells.Rows.Count
        Ligvid = 1
        For Cptr = 1 To Nbre
        Lig = .Columns("A").Find(motcherche, .Cells(Lig, "A"), xlValues).Row
        Paquet = .Range(.Cells(Lig, "A"), .Cells(Lig, "L")).Value
        Sheets(2).Cells(Ligvid, "A").Resize(1, 12) = Paquet
        Ligvid = Ligvid + 1
        Next
        End With
        Sheets(2).Activate
        End Sub

        Sub test()
        copier_si "tata"
        End Sub
        testé OK sur une petite maquett de quelques lignes